Perl Advent Calendar 2024

Merry Christmas, bless us, everyone

2024-12-24T00:00:00Z

Merry Christmas, one and all.

A quarter of a century (and, obviously, twenty five days) ago I created the very first Perl Advent Calendar entry. This Christmas, I'd like to take a minute to talk about all the wonderful presents this has given us over the years.

Over this time the world has changed, and Perl's role in the world with it. Twenty five years ago was the dawn of the dot-com boom, where we were concerned with the battle between Perl and Python, and the new upstart of Java. Which would be the dominant language? Twenty five years later we can see the fallacy of this debate - all of the languages won. We live in a vastly more complicated world where the Internet is now always on, in our pockets and on our wrists, controlling everything from our light switches to how we interact with our governments. And powering this is a plurality of programming languages, each with its own advantages and disadvantages, quirks and foibles, allowing people to use the best language for the task at hand - Java, or Python, or our beloved Perl - or any number of interesting and exciting language brethren new and old.

With the development of the cloud and cloud technologies the old battle for the server is immaterial. Where we once used to fret over if Perl or Python was installed on "the server" and available for us (and which version!), we now have the ability to easily obtain whatever environment we want to use whichever language we want. Where we used to have to hand install software on the operating system this was supplanted by package systems, then by fleet management systems like ansible and puppet that could reproducibly install and manage any language we wanted across a whole fleet of machines, and then by virtual machine technologies like Amazon's AMI system that can be used to quickly create a "throwaway" machine with whatever machine image we want installed on it.

We now live in the Docker (container) world where each script can have its own version of Perl, with exactly the dependencies it needs installed just for it.

Perl 5

This changing environment has influenced Perl, allowing it to flourish in a way that we never would have imagined twenty five years ago. By making installing software easier we freed ourselves from the concept of the "core" Perl language extending what we could use out into reliably having whatever bits of CPAN we want at hand. This brought the philosophy of "CPAN is the language" to the forefront.

Much of the work on Perl in the last twenty five years has been adapting the core interpreter so that it's possible to modify it more and more by simply installing a module. Where we once begrudgingly relied on source code modifications to blindly manipulate the raw text of the code in order to add brand new language features we now exist in a world of pluggable syntax where such changes can be made in collaboration with perl's own parser giving us (almost) infinite adaptability.

The history of Perl has moved from higher level abstractions being built in large swaths of Perl code to code being made available on the CPAN that can integrate ever closer with the interpreter itself. Now finally in the last few years we've seen some of these experiments being turned into best practices that are built into the language itself.

When I first learned Perl in 1998, I started with the "pink" version of Larry Wall's "Programming Perl" book, which only covered Perl 4 and hence didn't cover the topic of objects at all. This resulted in some of the first Perl 5 code I wrote looking like this:

sub triangle_area {
&nbsp;&nbsp;&nbsp;&nbsp;my $tri = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $tri-&gt;{width} * $tri-&gt;{height} / 2;
}

my $shape = { width =&gt; 3, height =&gt; 4 };
print triangle_area($shape), &quot;\n&quot;;

My understanding of Perl changed pretty quickly when I started reading the man pages for the version of Perl I had installed and got my hands on the "blue" second edition of "Programming Perl".

Learning Perl 5's object model meant the kind of Perl I would write would be more like this:

use strict;
use warnings;

package Triangle;

sub new {
&nbsp;&nbsp;&nbsp;&nbsp;my $class = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my %args = @_;
&nbsp;&nbsp;&nbsp;&nbsp;my $self = { width =&gt; $args{width}, height =&gt; $args{height} };
&nbsp;&nbsp;&nbsp;&nbsp;return bless $self, $class;
}

sub width  { return $self-&gt;{width} }
sub height { return $self-&gt;{height} }

sub area {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;width * $self-&gt;height / 2;
}

package main;
my $shape = Triangle-&gt;new(width =&gt; 3, height =&gt; 4);
print $shape-&gt;area(), &quot;\n&quot;;

This was so much better. We did't have to name the area method with a triangle_ prefix in order to disambiguate it from the any rectangle_area or circle_area function we might have in our code base.

Then in 2006 along came Moose which enabled a much more powerful way to write objects:

package Triangle;
use Moose;

has width  =&gt; (is =&gt; 'ro');
has height =&gt; (is =&gt; 'ro');

sub area {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;width * $self-&gt;height / 2;
}

package main;

use strict;
use warnings;

my $shape = Triangle-&gt;new(width =&gt; 3, height =&gt; 4);
print $shape-&gt;area(), &quot;\n&quot;;

Later, in 2017, we had the first release of Mu which allows us to write something quite a bit shorter:

package Triangle;
use Mu;
ro 'width';
ro 'height';

sub area {
&nbsp;&nbsp;&nbsp;&nbsp;my $self = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;width * $self-&gt;height / 2;
}

package main;

use strict;
use warnings;

my $shape = Triangle-&gt;new(width =&gt; 3, height =&gt; 4);
print $shape-&gt;area(), &quot;\n&quot;;

This is not only shorter, but it also has more error checking - if you don't pass both width and height to new, you'll get an error.

Last year we had the release of Perl 5.38. This brought into core a bunch of syntax (admirably still experimental) that we started as a community playing with in 2008 with MooseX::Declare - but implemented much better and safer. The code above can now be simplified even further:

use v5.38;
use feature 'class';

class Triangle {
&nbsp;&nbsp;&nbsp;&nbsp;field $width  :param;
&nbsp;&nbsp;&nbsp;&nbsp;field $height :param;
&nbsp;&nbsp;&nbsp;&nbsp;method area { return $width * $height / 2 }
}

my $shape = Triangle-&gt;new(width =&gt; 3, height =&gt; 4);
say $shape-&gt;area();

The Legacy of Perl

Perl has changed throughout the years, but it's always been Perl, with core ideas that have defined not only the "Perl way" of doing things for Perl, but elsewhere too!

These ideas have infected the way we write code, not just in Perl, but in all modern programming languages. Amazing things that sprung up in Perl have become table stakes in other languages. The idea of having a central repository such as the CPAN that is the defacto place where you can find open source libraries that can be easily installed have become the norm - just look at JavaScript's ever popular npm, Python's PyPI, and Ruby's RubyGems as examples. The concept of shipping these libraries with working tests like everything on the CPAN has been adopted everywhere, with CI/CD systems validating any serious software dependency on any commit.

These aspects of Perl - along with countless other things - means that twenty five years on not only can I still enjoy writing Perl code in more powerful and fun ways than I ever could, but when I need to use another language better suited to a particular niche, a lot of the things I loved about Perl twenty five years ago are already there waiting for me.

The Advent Calendar Itself

Speaking of things that other languages have adopted...

The story of the Perl Advent Calendar starts, like all good stories, with a bad idea in the pub the night before. I don't eat chocolate, so I was lamenting at a Perl Mongers social meeting that there were no good advent calendars for me - just the ones with a little picture behind the windows. I was saying that you should be able to get some other kind of reward. And then I thought how about some cool code?

So the Perl Advent Calendar was born. Or it was the very next day, when I put the whole thing together during my lunch break. Back then I just named a module for the day and included the module's POD as the advent calendar - next year I introduced a small description of why I'd picked it along with the POD, and the year after is when the full article format was introduced with links to search.cpan.org (and later metacpan) for the documentation.

This turned out to be surprisingly popular, with the website being featured in NTK and on Slashdot (getting mentioned by Slashdot was a big deal in 1999).

It wasn't long before there were imitators for other programming languages. It became a tradition in the software world to have an Advent Calendar for your language of choice (or area of programming language - Perl has seen quite a few separate calendars for things like Perl 6, Catalyst, and even futures and promises). We now even have the Advent of Code which is a small advent calendar of programming puzzles that's hugely popular (I, for my part, have never had time to do it since I was always spending time tweaking the Perl Advent Calendar at this time of year).

Through the years the Advent Calendar became too much for me to manage on my own. I could no longer keep writing all twenty five articles myself, and so I started taking submissions. I eventually gave the calendar away for others to maintain, took it back again years later, and then finally gave it away again. Like any good project, it's totally grown beyond me and has a life of its own.

The crucial thing about the calendar - more important than any one article, any one year, or even any one programming language - is the idea that we can all enjoy learning about our favorite programming language. Things don't have to be taught in boring instructions, but instead learning about something can be silly, daft, fun, and a treat! Why not have a story about how Santa's elves are all Perl programmers faced with saving Christmas, and the only way to do it is to use this module? Why not have a tale about how we can control Christmas lights with Perl? Create Christmas memes? Many a clever person in the Perl community has talked about optimizing projects for fun - attracting volunteers by making projects enjoyable to be a part of - and the Perl Advent Calendar embraces this idea of rewarding everyone that reads it with joy. This popular format has been copied by other languages.

A Merry Christmas to us all; Bless us, everyone

So, as I try to do every year, and on this twenty-fifth year of the Perl Advent Calendar, I wish you a Merry Christmas.

Perl has this concept of "blessing" references to turn them into objects. One way to look at it is it's Perl's way of making something more than what it is - improving it, giving it powers and abilities it didn't have before.

So when I say "Bless us, everyone" I'd like you to think about how Perl has "bless"ed everyone. Each programming language that has their own version of CPAN. Each programming language that has their own Advent Calendar. Everyone who's written something daft just for the heck of it, and then shared it so people can learn. These are all things that Perl has helped bring to the world, and means that - even if you've never used Perl - you're still a sort of Perl programmer. Because Perl is more than a language, a run-time - it's about the people and ideas behind it.

merry $christmas; bless $us, Everyone

A New Logo for Perl

2024-12-23T00:00:00Z

The Backstory (2020)

For many years, the question of what is or is not Perl's logo has been quite murky. There is a fair amount of backstory and there is too much to dive into right here, but I will happily point you at Neil Bowers' tackling of the subject from 4 years ago: https://neilb.org/2020/12/04/perl-and-camels.html It's a quick, but informative read. I encourage you to take a peek.

The TL;DR of it all is that Neil suggested:

that Perl could adopt a new camel logo—separate from the one used on O'Reilly's book cover—and use it as the official symbol for the Perl language.
the goal would be to create a logo that represents not just the language but also the community, one that feels friendly and welcoming.
He acknowledged that the "camel association" will always be tied to Perl, even if a new logo is chosen, but suggested this as a pragmatic approach

The Perl Toolchain Summit (2024)

At the Perl Toolchain Summit in Lisbon this year, a small group of us had a chat about the logo (or non-logo) situation. The majority opinion was that someone should come up with a logo and present it for community use. Neil Bowers and I were nominated to take this on. Over the summer, Neil commissioned Zach Roszczewski to come up with a new camel. Babs Veloso, Neil and I gave some initial feedback. After we were happy that we could proceed, we widened the circle of participants to a small, shadowy cabal, chatting on TPRF Slack. Among these were Sébastien Feugère and Thibault Duponchelle, who had previous wrestled with the logo topic. Later, I participated in a call with the PSC, where they gave some feedback on the logo. When I was at the London Perl and Raku Workshop this past October, Sébastien, Thibault, Leo Lapworth and I got in a room together to discuss a path forward. We aimed to have a logo available for announcement as part of the Perl Advent Calendar, and here we are.

Over the past week, we have polled various others for opinions on the logo and various versions of it. The result of all of this is the logo you see at the top of this article.

Feedback on Sébastien Feugère's work was kindly given (in first name alphabetical order) by:

Aristotle Pagaltzis
Bruno Meneguele
D Ruth Holloway
Dallas Hogan
Graham Knop
Kenta Kobayashi
Leo Lapworth
Makoto Nozaki
Marc Perry
Mohammad Anwar
Philippe Bruhat
Robert Spier
Thibault Duponchelle

The License

The license for this logo is CC-BY. That means that you are free to create derivative works based on the logo, with the only condition being attribution. We would love for this logo to be used widely, so we wanted to go with a permissive license.

Who Put You in Charge?

Nobody. In the absence of a benevolent dictator or a governing body for all of the Perl communities, nobody has a mandate to create a logo for the Perl language and all of the communities attached to it. Our only hope is that this logo is seen as a gift and that if you like it, you will use it.

Traditionally the way that things work in our communities is that someone creates something in the hopes that it will be adopted by others. That may or may not happen, but the end result is entirely up to the various Perl communities. We hope that you like this logo. We hope that you use it. We are happy to work with you on using it, but we are not in charge of anything and it would be disingenuous to pretend it were otherwise.

What About The Perl and Raku Foundation?

This logo is not affiliated with The Perl and Raku Foundation in any way. The foundation has its own logo (the onion), which can also be used under certain conditions. As far as I can tell, there is no appetite within the foundation to wade into the Perl logo debate. Having said that, an onion is not a camel, and I refer you to Neil's blog post quoted above for an argument about why the logo really should just be a camel.

Where Can I Get a Copy of the Logo?

The logo currently lives in the metacpan/perl-assets repository. The repo is still a work in progress, but this is where you should be able to find static assets moving forward.

Where Can I Give Feedback?

Please open an issue if there's something you'd like to discuss. Items worth discussing are:

minor changes to the logo layout and look
general issues related to using the logo
offers of help

Items not currently worth discussing:

this should be something other than a camel
this requires a ground up redesign
I hate it

Are There Other Options?

Yes, we would like you to have many different options when it comes to using the camel. I'm including some of them below.

Who Owns this Logo?

Neil Bowers was the initial owner of the new camel. He has transferred the ownership of the original camel artwork to me. My preference would be to transfer ownership to MetaCPAN, but it's not a legal entity, so I'm not entirely sure if that is possible. Since the license is CC-BY, I don't actually know how much ownership matters, but for the time being, I am the camel's steward.

What's Next?

We consider the logo to be production ready, but also a work in progress. We are in the process of approaching stakeholders and speaking to them about integrating the logo. In addition this, I expect the logo to be used in some way on both perl.com and metacpan.org.

There are still some assets which need to be settled -- like a favicon.ico, but if all goes well that should be taken care of in the very near future.

It is my hope that the various Perl communities can standardize on this logo in the near term. This doesn't have to be the forever logo for Perl, but just generally getting people on the same page would be an excellent start.

If you think this logo is a good fit, please accept it as our gift to you. If it's not a good fit for you, that's ok too. TIMTOWTDI!

use VERSION

2024-12-22T00:00:00Z

A yearly non-December gift

December is not the only season for gifts. Every year, sometime around the end of May, the Perl 5 Porters gift us with a new version of Perl. Or is it perl?

To quote "What's the difference between "perl" and "Perl"?" in perlfaq1:

"Perl" is the name of the language. Only the "P" is capitalized. The name of the interpreter (the program which runs the Perl script) is "perl" with a lowercase "p".

You may or may not choose to follow this usage. But never write "PERL", because perl is not an acronym.

The version of perl (the interpreter) is what you get when you type perl -v on the command-line:

    $ perl -v
    This is perl 5, version 40, subversion 0 (v5.40.0) built for x86_64-linux-gnu

    Copyright 1987-2024, Larry Wall

    Perl may be copied only under the terms of either the Artistic License or the
    GNU General Public License, which may be found in the Perl 5 source kit.

    Complete documentation for Perl, including FAQ lists, should be found on
    this system using &quot;man perl&quot; or &quot;perldoc perl&quot;.  If you have access to the
    Internet, point your browser at https://www.perl.org/, the Perl Home Page.

You can also run this (the interpreter version is available in two different formats, either as a floating-point number, or a v-string):

    $ perl -E &#39;say for $], $^V&#39;
    5.040000
    v5.40.0

What's in the box? New features!

New versions of Perl come with bug fixes, speed improvements, deprecations and also new features. It's still the same old Perl, that will continue to run your existing code. Perl version upgrades are so simple and drama-less they're almost boring. (The Perl 5 Porters support the two most recent stable releases of Perl, which should be reason enough to upgrade your binary.)

Long story short, Perl is extremely backwards compatible. This means that sensibly-written code from 20 years ago should still run under the next release of Perl. In other words, any perl interpreter should understand code written against older versions of the Perl language just fine. As I have personally experimented, this actually even applies to scripts targeting version 4 of the language!

With such a strong commitment to backwards compatibility, how does one even introduce new features to the language? To quote from "DESCRIPTION" in feature:

It is usually impossible to add new syntax to Perl without breaking some existing programs. This pragma provides a way to minimize that risk.

The feature module was introduced in Perl v5.10, to make it possible to introduce new features to the language without breaking existing scripts. A typical example would be the say feature, which makes it possible to add the say keyword to the language without breaking older scripts that might have defined a sub say.

If one wanted to use the say builtin, they would write:

use feature 'say';
say &quot;Hello, world!&quot;;

And of course, code that already has a say subroutine defined would continue to work the same, as long as the feature is not enabled. This leaves time for the code's author to look at their code and decide if they want to update it to take advantage of new features of the language.

Note that enabling features always happens in the current lexical scope.

The gift of choice

Backwards-compatibility is preserved thanks to a compromise: people have to opt in to the new features. The unfortunate side-effect is that Perl will continue to look the same (sometimes giving the feeling it's stagnating) until you enable the new features!

It should be noted, however, that not all Perl features are guarded by the feature module. Syntax constructs that were syntax errors in previous versions of Perl can be introduced without a guard, and many were. The Syntax::Construct module has an exhaustive list of "syntactic constructs that are not implemented via the feature pragma, but are still not compatible with older versions of Perl".

Perl v5.40 knows about 25 features. While they can be enabled or disabled (some features are used to disable undesirable constructs, like indirect object notation) one by one, there is a better way than 25 lines of boilerplate.

`use VERSION`

A special case of the use builtin is use VERSION. It performs several operations:

Enforce running with a minimum version of the perl binary

The first thing that use VERSION does is to declare which minimum version of perl (the interpreter) you expect to run your code. If you demand a version later than that of the perl binary currently running your code, it's going to die at compile time.

    $ perl -Mv5.38 -e1
    Perl v5.38.0 required--this is only v5.36.0, stopped.
    BEGIN failed--compilation aborted.

Although the version in use VERSION can be written in either v-string style (v5.36) or numeric style (5.036), it is strongly recommended to use the former, as it's more readable and matches with the way people talk about Perl versions. (Unless the code is expected to actually be run on a perl older than v5.8, which was released in 2002).

Load the corresponding feature bundle

The feature module also defines "feature bundles", which allows to load (or disable) multiple features together. (See "FEATURE-BUNDLES" in feature for their definitions.)

The special use VERSION construct will implicitly load the corresponding feature bundle. For example:

use v5.10;

will implicitly load the corresponding feature bundle:

use feature ':5.10';

which will enable the say, state and switch features. The parser will now understand the corresponding keywords, and behave accordingly. Error messages might differ a lot when a feature is enabled or not.

Note that adding a subversion (e.g. use v5.36.3) will have no effect on the bundles loaded (feature bundles are guaranteed to be the same for all sub-versions). It will of course have an effect on the interpreter version check described above.

In addition to the implicit loading of features, use v5.12 or greater will enable strict, use v5.36 will enable warnings and use v5.40 will import builtin functions (using a similar version bundle scheme: see "Version-Bundles" in builtin).

Note that use VERSION is a lexical pragma, meaning that you could declare different version bundles for different parts of your code. For consistency, it's really recommended that you pick one version, and stick with it for the entire file. In fact, a future release of perl will disallow changing the version once one has been declared. So, really, don't do that.

The features included in bundles fall in two broad categories: new features, and deprecated features. Loading a bundle will perform the following two operations in a single line of code:

Enable modern Perl features

Before features become part of the "official" language, they are often introduced as experiments. Experimental features are available only when requested via use feature, and aren't part of a bundle. In fact, they'll even issue warnings when you use them. (See experimental for more about this.)

For example, the signatures feature was introduced in perl v5.20, and remained experimental until v5.34. That meant that, as long as the perl binary was more recent than v5.20, one could use signatures in their code with use feature 'signatures'. That specific feature has been added to all bundles since :5.36, which means that a single declaration (use v5.36, or any later version) allows one to write Perl subroutines using signatures.

Not all new features have to wait that long to become part of the language: module_true was introduced in perl v5.38, and was immediately added to the :5.38 feature bundle.

Deprecate discouraged features

Bundles have also been used to disable features that have become discouraged. These are made part of the :default feature bundle, and not included in later bundles.

Doing it this way makes it possible to preserve the behaviour of ancient, unmaintained scripts and modules. Even if they load some feature bundle (via use VERSION), any discouraged feature they might use will also be (retroactively) included in that bundle, preserving backward compatibitlity.

This is how the features indirect, multidimensional and bareword_filehandles came to be "removed" from later versions of Perl.

This is the strategy the Perl Steering Council has chosen to best stretch the language between the continuous introduction of new features and the preservation of backwards compatibility. For the record, many Perl 4 (which is functionally identical to Perl 3, from late 1989) scripts still run fine with perl v5.40.

Why pick a Perl version?

Line 0 semantics

When perl compiles Perl code, before it even reads the first byte of source code, it is in "Perl v5.8 compatibility mode". The :default bundle is implicitly loaded (it only contains features that are backward-compatible with traditional Perl).

This means that the "sensibly-written code from 20 years ago" mentioned above is very likely to just run unmodified, and simply work.

As explained above, unguarded syntactic features are available from line 0.

Line 1 semantics

We've seen that use VERSION automatically loads the corresponding feature bundle (and associated builtins). This single line of code enables all official features and disables all deprecated features for the given version of the Perl language.

In other words, putting a use VERSION line at the top (line 1) of a Perl script or module declares which version of the Perl language the code that follows is written under. And because the effect is lexical, a script can load other modules that declare they were written against a different version of the language, and everything works transparently.

I strongly believe that use VERSION should be the first line of any Perl code.

Declaring a baseline of the Perl language

For decades, the first recommendation made to Perl beginners and people asking for help on a Perl forum was to add use strict; use warnings at the beginning of their code. This made Perl more helpful, as it would point to likely errors in programming (like undeclared variables or undefined values).

Since Perl v5.36, these two statements are implicitly included via use VERSION. It also enables the official features of that version of the language, and disables the deprecated ones.

Therefore, use VERSION helps define a good baseline for the Perl language, so that the compiler can fully understand the code that follows. It's of course possible to include experimental features, or re-enable deprecated features (the latter is really not recommended), to fine-tune the specific dialect of Perl in which the code is written.

Future versions of perl implicitly promise that they will understand the dialect of Perl declared by use VERSION, and that they will run it to the best of their abilities.

The Once and Future Perl

The new "use strict and warnings"

Since the time of "use strict and warnings" as minimum requirements for decent Perl code, the language has evolved, and brought in more useful features. It also deprecated ancient features that were deemed bad ideas in a modern context (such as the indirect object notation).

Writing use VERSION as the first (active) line of any Perl code will declare to the perl interpreter (and to whoever is reading the code) which version of the Perl language the code that follows is written in.

So, just put a use VERSION line at the top of all your Perl files.

Whenever a new stable version is released (which happens every year towards the end of May), you should at least read the perldelta that accompanies it, and check if you see some new feature you think you'd want to use.

There might exist some compatibility modules that you can use, to get a taste of those new features on a version of perl that doesn't support them natively. They might behave slightly differently, though.

v5.36 (released in May 2022) contains a very good mix of stable features (default strict and warnings, signatures, isa), as well as the removal of deprecated features (indirect, multidimensional).

Most Linux distributions released in 2024 include a version of Perl that will support use v5.36.

Picking which version of Perl to code in

The version of the Perl language you want to use will depend on the context in which the code is run. Private or proprietary code has different constraints than an Open Source project or library distributed on CPAN.

Private or company code is only limited by the version of Perl used internally. It might be the stock perl from the operating system selected by the organization. It might be a perl compiled specifically for that purpose. Internal company or personal code can run on the bleeding edge!

An Open Source project will usually be shipped with or installed on top of common operating systems, and will usually be tied to the version of perl these operating systems package.

The authors of modules distributed via CPAN distributions might want their code run on a broader selection of perl versions.

However, you're unlikely to be able to start writing code with the latest version of the language very quickly:

maybe you're stuck with the version released by your OS vendor (but, do you know how easy it is to compile your own Perl?);
maybe you compile your own Perl, but it's a core part of your infrastructure, and upgrading takes time; (although the Perl parts are likely to be the easiest ones, given Perl's track record with backward and forward compatibility)
maybe you're a CPAN author, and you still want to support older versions of Perl.

Updating your Perl code at your own pace

At work, across all of our tens of thousands of Perl modules, over 30 different VERSION are declared with use VERSION. From v5.1 (someone typoed 5.010 as 5.001) up to v5.36, going through v5.10, v5.18.2 (someone didn't know the sub-version is ignored), v5.24, etc. Many files don't have a use VERSION line (using the Perl flavor of 2002, when our Perl code base was started). The word for this is "legacy".

Since the effect of use VERSION is lexical, it's possible to upgrade the version of the language your code uses one file at a time (or even one scope at a time, but see "Restrictions to use VERSION declarations" in perl5400delta for why you'll probably want to stick with the whole file).

I can confirm it's really nice to be able to first upgrade the Perl binary without changing a single line of code, and then choose which files to upgrade first.

That transition can be difficult, though:

v5.28 subtly changed the meaning of |, &, ^ and ~ (the bitwise feature is enabled)
v5.36 won't understand $fido = new Camel "Amelia" (the indirect feature is disabled)
v5.36 will complain about sub foo ($$) (the signatures feature is enabled, prototypes must be declared as an attribute)
v5.38 will complain about open FH, $file (the bareword_filehandles feature is disabled)

Picking exactly which version of the Perl language to use is the actual question one has to answer. And the answer will be different if one is a CPAN author, a hobbyist writing their own tools, an Open Source application developer or a developer for a company's web application or internal tooling. The answer depends on several factors: one of them is the programmer's desire to use recent Perl language features, and another is their expectations regarding the minimum version of the perl binary the code is expected to run on.

Updating your Perl code faster

With tens of thousands of files to potentially update, I didn't imagine for one second that I would do it manually. And even if my colleagues would also help, I knew that upgrading the use VERSION line in their code would make some of them uneasy.

So I wrote a module that would take Perl code, statically analyze it using PPI, and bump the declared version to the requested one, while being extra careful about the issues detailed above (and others). Since that code contained no company secret, I was allowed to open source it.

The code now lives on CPAN as Perl::Version::Bumper. And has improved a lot since my last commit in the company repository. I've actually deleted the code since, and we now depend on the CPAN module.

Here are a few examples of what it does, assuming we want to bump the example code to v5.40:

simply bump the version number:

print &quot;Hello, world!\n&quot;;

becomes:

use v5.40;
print &quot;Hello, world!\n&quot;;

remove compatibility modules that become unnecessary once the corresponding feature is enabled by the bundle:
```
use Say::Compat;
say &quot;Hello, world&quot;;
```
becomes:
```
use v5.40;
say &quot;Hello, world&quot;;
```

remove warnings about experimental signatures, once they come out of experimental:

use v5.20;
use feature 'signatures';
no warnings 'experimental::signatures';

sub greeting ( $who ) { &quot;Hello, $who!&quot; }
say greeting &quot;world&quot;;

becomes:

use v5.40;

sub greeting ( $who ) { &quot;Hello, $who!&quot; }
say greeting &quot;world&quot;;

rewrites prototypes when enabling the signatures feature:

use v5.10;
sub greeting ( $ ) { sprintf &quot;Hello, %s!&quot;, shift }
say greeting &quot;world&quot;;

becomes:

use v5.40;
sub greeting :prototype( $ ) { sprintf &quot;Hello, %s!&quot;, shift }
say greeting &quot;world&quot;;

disable features that might cause problems, and add a warning about them:

use v5.10;
say &quot;hello, world!&quot; | &quot;@&quot;;    # flip the capital bit on the first letter

becomes:

use v5.40;

# IMPORTANT: Please double-check the use of bitwise operators
# before removing the `no feature 'bitwise';` line below.
# See manual pages 'feature' (section &quot;The 'bitwise' feature&quot;)
# and 'perlop' (section &quot;Bitwise String Operators&quot;) for details.
no feature 'bitwise';
say &quot;hello, world!&quot; | &quot;@&quot;;    # flip the capital bit on the first letter

In safe mode, stop at the last version that compiles (v5.38 disabled the bareword_filehandles feature, turning their use into a compile-time error):

open FH, 'greeting.txt' or die &quot;Can't open file: $!&quot;;
print FH &quot;Hello, world!\n&quot;;

becomes:

use v5.36;
open FH, 'greeting.txt' or die &quot;Can't open file: $!&quot;;
print FH &quot;Hello, world!\n&quot;;

Since the module is meant to upgrade older Perl code, I made sure it can run on perl binaries as old as v5.10. And it can use perl5.10.0 to upgrade source code up to v5.40!

The distribution contains a small command-line utility to process many files at a time: perl-version-bump.

It runs in safe mode by default, meaning it will start at the version of the perl used to run it, and decrease the target version number until the generated code compiles, or give up.

If I can suggest some New Year Resolutions for 2025:

decide which version of the Perl language you want to code against in your various projects,
start consistently adding use VERSION on line 1 of all your Perl files,
and bump the existing versions where it makes sense!

That Time Perl+OpenMP Saved Christmas

2024-12-21T00:00:00Z

It was Christmas Eve, and Santa was facing a nightmare. The sleigh’s new GPS system, upgraded for the first time in centuries from following the Star of Bethlehem, was malfunctioning. As Santa checked the screen, the map was a chaotic mess — locations were wrong, some coordinates did not make sense, and the sleigh was heading straight into the mountains instead of over the City of New Orleans!

Santa's CURRENT position read-out indicated he was over the Appalachians at the following coordinates:

  Sleigh Latitude  Sleigh Longitude  Sleigh Altitude (ft)
       38.0000&deg; N        -81.500&deg; W              300

When he should be nearly exactly at,

  Sleigh Latitude  Sleigh Longitude  Sleigh Altitude (ft)
       29.9500&deg; N        -90.070&deg; W              300

"We can't afford this!" Santa shouted. "We’ve got billions of presents to deliver, and the system's down. And I want some gumbo!"

"Santa, we can fix it," Jingles, the lead elf, said with a frantic smile. "We just need more computing power. If we use OpenMP, we can parallelize the calculations and solve this quickly."

Santa stared. “What are you talking about, Jingles? I'm a giant elf, not a Scottish engineer on a television show for nerds!”

“We’ll solve the GPS problem by recalculating the distances to each delivery location. The sleigh’s GPS relies on triangulating data from multiple satellites. Right now, it's too slow to process the data for each location one by one. We can use OpenMP to divide the problem into smaller parts, calculate distances in parallel, and get this fixed fast!”

The data format of the positional satellites consisted of their positions in latitude, longitude, with an altitude; so the computations are necessarily in 3D space, and could contain any number of lines:

  39.2497677581748 -66.1173923826129 29161.8658117126
  -39.9677413540029 -41.3796046007432 23577.9949741844
  82.2366387689737 153.417562140013 20022.1066827945
  -43.4383552881127 -44.5406041422343 28011.9118605715
  14.0767035175103 4.23608833137735 27766.7951824014
  40.8573795733001 162.321349651587 25625.9162363042
  -26.9656081428904 27.0935089406365 23681.3611776769
  70.1644045619636 6.85910122836034 26946.7435635683
  -64.5469805915126 -14.9091572762404 24893.2320145114
  80.875127931392 -109.736894500449 23367.1123572306
  5.62494420727084 -70.3599057022578 24677.4930437516
  -78.594647140356 -69.1886836681495 21775.1041983417
  -20.7093134304093 50.3824566178804 28396.5251214701
  -8.19130244183 28.3379349990834 24113.3081697615
  -62.1626942859846 -165.892484372947 27881.1415552865
  -39.1505435434735 -14.0167682855066 25391.598017652
  -14.701859640773 33.3797684668173 28958.4392020613
  22.7094543766397 28.9295184727116 29847.2350918171
  58.9987788505186 -87.6847921052664 29544.1317147911
  83.6874173858257 -149.058764882263 22417.9224396509
  -8.01336267852399 97.8876777856595 27879.4674084787
  -55.3867650906297 -107.353651427755 21389.9702111095
  -78.8588152992001 -155.558248147836 25430.0402744441
  9.88995820014878 -0.204367766261981 20832.5618074863
  -76.8565255868645 -14.4804333171123 27013.5287117141
  -0.16890065869049 -40.7974093702016 22440.2960018416
  8.56759320194605 14.0242190926548 24229.1350707098
  89.3116725410715 19.3710347706399 28181.9446348641
  ...

The distance formula was computationally expensive, involving square roots and trigonometry. But by using OpenMP, the task could be split into multiple OS threads, each calculating the distance to one satellite at the same time. The results would then be aggregated, and the sleigh's GPS would know exactly where to direct its heading.

The code would parallelize the work by dividing the list of satellites among a number of pthreads using OpenMP's #pragma omp for construct! OpenMP::Simple handles the required #include <omp.h> and makes it easy to query the environment for information, such as OMP_NUM_THREADS.

Jingles quickly typed up a solution in Perl, his favorite programming language. The solution was simple but critically offloaded the triangulation computations to Inline::C code containing OpenMP directives, using the OpenMP module on CPAN.

use strict;
use warnings;

use OpenMP;

use Inline (
&nbsp;&nbsp;&nbsp;&nbsp;C    =&gt; 'DATA',
&nbsp;&nbsp;&nbsp;&nbsp;with =&gt; qw/OpenMP::Simple/,
);

my $omp = OpenMP-&gt;new;

$omp-&gt;env-&gt;omp_num_threads($ENV{OMP_NUM_THREADS} // 8); # accept number of threads via commandline

# Sleigh's CURRENT position (latitude, longitude, altitude)
my $sleigh_lat = 38.0000;
my $sleigh_lon = -81.500;
my $sleigh_alt = 300.0; # in meters

# Satellite positions in tab-delimited format
my @satellites = ();
open my $FH, &quot;&lt;&quot;, &quot;./satellite-data.txt&quot; || die $!;

foreach my $line (&lt;$FH&gt;) {
&nbsp;&nbsp;chomp $line;
&nbsp;&nbsp;push @satellites, [split(/[\s\t]+/, $line)];
}

# Function to calculate distance from sleigh to each satellite using OpenMP::Simple,
# a subclass of Inline::C!
my $distances = calculate_distances($sleigh_lat, $sleigh_lon, $sleigh_alt, \@satellites);

# Print the calculated distances
foreach my $distance (@$distances) {
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Distance: $distance meters\n&quot;;
}

Santa watched as Jingles split up the computational load. Each satellite’s data was handled in parallel by different threads, and within seconds, the recalculations were done. The GPS latency issues were fixed. Jingles already had some thoughts of improvements he could make using OpenMP's ability to target GPUs directly, but was quite happy with the current resolution.

Just as the final calculations finished, a gentle voice spoke, “When Faith sanctifies morally neutral technology, Good things are possible at Internet scale.”

Santa turned to see the Holy Family - Baby Jesus in the arms of His Virgin Mother accompanied by His foster father, Joseph; by the sleigh, smiling serenely. “Thank you,” Santa whispered. “Merry Christmas.”

With the sleigh back on track, Santa soared into the night sky.

When things settled down, Santa was able to look at Jingles' full code, and it was something to behold!

use strict;
use warnings;

use OpenMP;

use Inline (
&nbsp;&nbsp;&nbsp;&nbsp;C    =&gt; 'DATA',
&nbsp;&nbsp;&nbsp;&nbsp;with =&gt; qw/OpenMP::Simple/,
);

my $omp = OpenMP-&gt;new;

$omp-&gt;env-&gt;omp_num_threads($ARGV[0] // 8); # accept number of threads via commandline

# Sleigh's CURRENT position (latitude, longitude, altitude)
my $sleigh_lat = 38.0000;
my $sleigh_lon = -81.500;
my $sleigh_alt = 300.0; # in meters

# Satellite positions in tab-delimited format
my @satellites = ();
open my $FH, &quot;&lt;&quot;, &quot;./satellite-data.txt&quot; || die $!;

foreach my $line (&lt;$FH&gt;) {
&nbsp;&nbsp;chomp $line;
&nbsp;&nbsp;push @satellites, [split(/[\s\t]+/, $line)];
}

# Function to calculate distance from sleigh to each satellite using Inline::C
my $distances = calculate_distances($sleigh_lat, $sleigh_lon, $sleigh_alt, \@satellites);

# Print the calculated distances
foreach my $distance (@$distances) {
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Distance: $distance meters\n&quot;;
}

__DATA__
__C__

#include &lt;math.h&gt;

// Function to convert geographic coordinates to Cartesian (x, y, z)
void geo_to_cartesian(double lat, double lon, double alt, double *x, double *y, double *z) {
&nbsp;&nbsp;double R = 6371000;  // Earth's radius in meters
&nbsp;&nbsp;double lat_rad = lat * M_PI / 180.0;
&nbsp;&nbsp;double lon_rad = lon * M_PI / 180.0;

&nbsp;&nbsp;*x = (R + alt) * cos(lat_rad) * cos(lon_rad);
&nbsp;&nbsp;*y = (R + alt) * cos(lat_rad) * sin(lon_rad);
&nbsp;&nbsp;*z = (R + alt) * sin(lat_rad);
}

// Function to calculate Euclidean distance between two points (x1, y1, z1) and (x2, y2, z2)
double calculate_distance(double x1, double y1, double z1, double x2, double y2, double z2) {
&nbsp;&nbsp;return sqrt(pow(x2 - x1, 2) + pow(y2 - y1, 2) + pow(z2 - z1, 2));
}

/* C function parallelized with OpenMP */

// Main function to calculate the distances from the sleigh to each satellite
AV* calculate_distances(double sleigh_lat, double sleigh_lon, double sleigh_alt, AV *satellites) {
&nbsp;&nbsp;&nbsp;&nbsp;int satellite_count = av_len(satellites) + 1;  // The number of satellites
&nbsp;&nbsp;&nbsp;&nbsp;AV* distances = newAV();  // Create a new Perl array (AV) to hold the distances

&nbsp;&nbsp;&nbsp;&nbsp;double sleigh_x, sleigh_y, sleigh_z;

&nbsp;&nbsp;&nbsp;&nbsp;// Convert sleigh's geographic coordinates to Cartesian coordinates
&nbsp;&nbsp;&nbsp;&nbsp;geo_to_cartesian(sleigh_lat, sleigh_lon, sleigh_alt, &amp;sleigh_x, &amp;sleigh_y, &amp;sleigh_z);

&nbsp;&nbsp;&nbsp;&nbsp;// Fetch satellite data into local arrays
&nbsp;&nbsp;&nbsp;&nbsp;double *sat_latitudes = malloc(satellite_count * sizeof(double));
&nbsp;&nbsp;&nbsp;&nbsp;double *sat_longitudes = malloc(satellite_count * sizeof(double));
&nbsp;&nbsp;&nbsp;&nbsp;double *sat_altitudes = malloc(satellite_count * sizeof(double));

&nbsp;&nbsp;&nbsp;&nbsp;// Populate satellite data into local arrays (from the Perl array)
&nbsp;&nbsp;&nbsp;&nbsp;for (int i = 0; i &lt; satellite_count; i++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;AV *satellite = (AV*) SvRV(*av_fetch(satellites, i, 0));  // Fetch the satellite at index i
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sat_latitudes[i] = ((double) SvNV(*av_fetch(satellite, 0, 0)));  // Latitude
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sat_longitudes[i] = ((double) SvNV(*av_fetch(satellite, 1, 0)));  // Longitude
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sat_altitudes[i] = ((double) SvNV(*av_fetch(satellite, 2, 0)));  // Altitude
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;// Declare a temporary array to hold distances for each thread
&nbsp;&nbsp;&nbsp;&nbsp;double *_distances = malloc(satellite_count * sizeof(double));

&nbsp;&nbsp;&nbsp;&nbsp;PerlOMP_GETENV_BASIC // read common environmental variables, provided by OpenMP::Simple

&nbsp;&nbsp;&nbsp;&nbsp;// Start parallel region
&nbsp;&nbsp;&nbsp;&nbsp;#pragma omp parallel shared(_distances)
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;// Parallel for loop to compute distances in parallel
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;#pragma omp for
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for (int i = 0; i &lt; satellite_count; i++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;_distances[i] = 0.0;  // Initialize

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;double sat_x, sat_y, sat_z;

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;// Convert satellite's geographic coordinates to Cartesian coordinates
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;geo_to_cartesian(sat_latitudes[i], sat_longitudes[i], sat_altitudes[i], &amp;sat_x, &amp;sat_y, &amp;sat_z);

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;// Calculate the distance from the sleigh to this satellite
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;_distances[i] = calculate_distance(sleigh_x, sleigh_y, sleigh_z, sat_x, sat_y, sat_z);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;// Combine the results from all threads into the main distances array inside the parallel region
&nbsp;&nbsp;&nbsp;&nbsp;for (int i = 0; i &lt; satellite_count; i++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;av_push(distances, newSVnv(_distances[i]));
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;// Free the private distance arrays and satellite data arrays
&nbsp;&nbsp;&nbsp;&nbsp;free(_distances);
&nbsp;&nbsp;&nbsp;&nbsp;free(sat_latitudes);
&nbsp;&nbsp;&nbsp;&nbsp;free(sat_longitudes);
&nbsp;&nbsp;&nbsp;&nbsp;free(sat_altitudes);

&nbsp;&nbsp;&nbsp;&nbsp;// Return the AV containing the distances to Perl
&nbsp;&nbsp;&nbsp;&nbsp;return distances;
}

__END__

See More:

https://metacpan.org/pod/OpenMP
https://metacpan.org/pod/OpenMP::Simple
https://metacpan.org/pod/OpenMP::Environment
Everyone is welcome to join the Perl+OpenMP Project at https://github.com/Perl-OpenMP/!

"Investigating a new respiratory virus outbreak in Santa's workshop"

2024-12-20T00:00:00Z

Christmas eve was quickly approaching, and Santa was trying to decide whether to purchase masks for all of the reindeer again this year (he was aware that there were documented cases of SARS-CoV-2 infecting White-Tail Deer (O. virginianaus), and he knew that Reindeer (R. tarandus) were closely related), when the Chief Elf interrupted his train of thought to inform him that two of the elves in the toy workshop were in the infirmary with respiratory distress. Testing had revealed that they were both infected with Respiratory Syncitial Virus (RSV), specifically with the RSVA subtype.

Santa asked "Do we know where they were exposed, or if one of them transmitted it to the other? We may need to require everyone at the North Pole to mask again until after Christmas eve . . . "

"The diagnostic lab says the two viruses are similar but not identical. Also they are not confident of the lineage calls and the clade assignments because we are using a new set of PCR primers designed in Edinburgh, which are based on a newer RSVA reference sequence (RefSeq). The problem is that we are using the RSVA phylogenetic tree available at usher.bio and that tree was built using the NCBI RefSeq as the root. You can see where the problem arises . . . "

Santa thought for a moment and said "Oh, blast! We aligned our fastq reads to the other RefSeq, and at the primer trimming step we are using the genomic coordinates from that different virus strain. So if we first align against the NCBI RefSeq genome (to get more accurate lineage calls and clade assignments) then the primer trimming step will not work as intended. Huh! Hmmm, do you think we could align those two different RSVA RefSeqs to each other and then modify the coordinates in the primer bed file so it uses the NCBI RefSeq's genomic coordinates instead?!?"

The Chief Elf sketched this out on the iceboard and said, "I think this could work. I will ask our bioinformatic software developers to tackle the problem."

And so gentle reader that is how we arrived at a simple, but tedious task of converting the genomic coordinates in this bed file:

  RS20000581      44      66      RSVA_1_LEFT     1       +
  RS20000581      434     464     RSVA_1_RIGHT    1       -
  RS20000581      359     385     RSVA_2_LEFT     2       +
  RS20000581      749     773     RSVA_2_RIGHT    2       -
  RS20000581      669     699     RSVA_3_LEFT     1       +
  RS20000581      1057    1083    RSVA_3_RIGHT    1       -
  RS20000581      990     1016    RSVA_4_LEFT     2       +
  RS20000581      1366    1389    RSVA_4_RIGHT    2       -

So that it would contain the correct coordinates from a different RSVA subtype RefSeq. It quickly became apparent that this problem could be solved much more quickly using the Awesome Power of Perl, unfortunately there was no out-of-the-box solution available in the existing base of Perl code. But how to proceed?

Using the Awesome Power of Perl in Bioinformatics

Each of the two genome files are simple text files consisting of an alphabet of five letters (A, C, G, and T (occasionally an N)) (technically RSV, similar to SARS-CoV-2 is an RNA virus, but life is simpler if we use 'T' instead of 'U'), all we need is a so-called "Global Alignment" of the two full-length sequences (they are each just over 15,000 bases in length). What we really want to know is where all of the longest stretches of identical sequences are located in the viral chromosomes. Fortunately an algorithm to calculate this was published by Needleman and Wunsch back in 1970; it is considered a classic example of dynamic programming (which builds up the answer without consuming vast amounts of memory). Furthermore, the National Center of Biotechnology Information (NCBI) maintains a server we can use to upload any two closely related nucleotide sequences.

The output from the N-W Global Alignment looks like this:

  Query  2177   GTGTGATTAACTACAGTGTATTAGATTTGACAGCAGAAGAACTAGAGGCTATCAAACATC  2236
                |||||||||||||||||||| |||| ||||||||||||||||||||||||||||||||||
  Sbjct  2221   GTGTGATTAACTACAGTGTACTAGACTTGACAGCAGAAGAACTAGAGGCTATCAAACATC  2280

  Query  2237   AGCTTAATCCAAAAGATAATGATGTAGAGCTTTGAGTTAATAAAAAGGTGGGGCAAATAA  2296
                ||||||||||||||||||||||||||||||||||||||||||||||  ||||||||||||
  Sbjct  2281   AGCTTAATCCAAAAGATAATGATGTAGAGCTTTGAGTTAATAAAAAA-TGGGGCAAATAA  2339

Where the the top sequence in each pair is a stretch of 60 bases from the Edinburgh RefSeq (Labeled 'Query') and the bottom sequence in each pair is the matching stretch from the NCBI RefSeq (Labeled 'Sbjct'). The unix pipe symbols denote a perfect match between the sequences at that base.

Notice that the numbering systems are slightly offset, AND that there is a gap introduced with a hyphen in-between the A at 2327, and the T at 2328 in the Sbjct, directly across from the G at position 2384 in the Query. That can be interpreted as a single nucleotide insertion in the Query genome. So creating the mapping table between the two coordinate systems is not trivial. The sequences only share 94 percent identity over about 15,200 nucleotides, which means they diverge 6 percent of the time.

To simplify the construction of our lookup table we can use grep to filter the starting alignment into two different subsets,

grep ^Query nw_alignment.txt &gt; just_rows_from_edinburgh_refseq.txt
grep ^Sbjct nw_alignment.txt &gt; just_rows_from_ncbi_refseq.txt

N.B. you will have to go in and manually remove the first extraneous Query line from the first file. These become the first two input files to our script, the third file is the primer bed file we are starting with.

Our Script that Creates a Lookup Table, and then Swaps Coordinates in a bed File

#!/usr/bin/env perl
use strict;
use warnings;

my $query_input = $ARGV[0];
my $subject_input = $ARGV[1];
my $input_bed = $ARGV[2];

open my ($FH1), '&lt;', $query_input or die &quot;Could not open $query_input for reading\n&quot;;
open my ($FH2), '&lt;', $subject_input or die &quot;Could not open $subject_input for reading\n&quot;;

my @global_array = ();
$global_array[0] = { query =&gt; undef,
&nbsp;&nbsp;&nbsp;&nbsp;sbjct =&gt; undef,
};

# This global counter serves as the index for the first data structure
# that captures the information at each place in the aligned sequences
my $counter = 0;

# Parse the rows of the first file
while ( &lt;$FH1&gt; ) {
&nbsp;&nbsp;&nbsp;&nbsp;chomp;
    # Each of these filtered rows has the same structure, in addition to
&nbsp;&nbsp;&nbsp;&nbsp;# A, C, G, and T, the N-W output can also contain hyphens (dashes), so
&nbsp;&nbsp;&nbsp;&nbsp;# our regex has to include that in the string we are capturing
    my ($seq) = $_ =~ m/Query\s+\d+\s+([\w\-]+)\s+\d+/;

    # Parse the 60 nucleotide string into individual characters
    my @qchars = split(//, $seq);
&nbsp;&nbsp;&nbsp;&nbsp;foreach my $q ( @qchars ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$counter++;
        # Load up the array of hashrefs with the symbols
        $global_array[$counter]{query} = $q;
&nbsp;&nbsp;&nbsp;&nbsp;}
}
close $FH1;


$counter = 0;
while ( &lt;$FH2&gt; ) {
&nbsp;&nbsp;&nbsp;&nbsp;chomp;
&nbsp;&nbsp;&nbsp;&nbsp;my ($seq) = $_ =~ m/Sbjct\s+\d+\s+([\w\-]+)\s+\d+/;
&nbsp;&nbsp;&nbsp;&nbsp;my @schars = split(//, $seq);
&nbsp;&nbsp;&nbsp;&nbsp;foreach my $s ( @schars ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$counter++;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$global_array[$counter]{sbjct} = $s;
&nbsp;&nbsp;&nbsp;&nbsp;}
}
close $FH2;

# Now we process the information in each element of the
# @global_array, and store that in this global hash
# the keys of this hash are genomic coordinates for the
# Edinburgh RSVA RefSeq and the values are the genomic
# coordinates of the NCBI RSVA RefSeq
my %ncbi_coordinates_of = ();

my $qcounter = 0;
my $scounter = 0;

# There is nothing useful in the [0] element
foreach my $i ( 1..$#global_array ) {
&nbsp;&nbsp;&nbsp;&nbsp;my $key = undef;
&nbsp;&nbsp;&nbsp;&nbsp;my $value = undef;

    # If the string from the N-W output contains a '-' then we
&nbsp;&nbsp;&nbsp;&nbsp;# need to handle those differently.  We only increment the
&nbsp;&nbsp;&nbsp;&nbsp;# $qcounter when the value in 'query' matches a letter
    if ( $global_array[$i]{query} =~ m/\w/ ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$qcounter++;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$key = $qcounter;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if ( $global_array[$i]{sbjct} =~ m/\w/ ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$scounter++;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$value = $scounter;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$ncbi_coordinates_of{$key} = $value;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$scounter++;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

# After all of that manipulation and data wrangling, the problem now becomes
# very simple.  We read in the starting primer bed file and iterate over each
# TSV record.  We use the information in columns 2 and 3 to query the
# %ncbi_coordinates_of hash, and insert the coordinates we want from the hash
# values.  The modified record is immediately printed to STDOUT

open my ($FH3), '&lt;', $input_bed or die &quot;Could not open $input_bed for reading\n&quot;;

while ( &lt;$FH3&gt; ) {
&nbsp;&nbsp;&nbsp;&nbsp;my @fields = split(/\t/, $_);

    # Change the sequence name in column 1
    $fields[0] = 'NC_038235.1';

    # It is formally possible that either the 'start' or the 'end' of the
&nbsp;&nbsp;&nbsp;&nbsp;# Query sequence is NOT in the %ncbi_coordinates_of hash, so check for this

&nbsp;&nbsp;&nbsp;&nbsp;unless ( exists $ncbi_coordinates_of{$fields[1]} and exists $ncbi_coordinates_of{$fields[2]} ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$fields[1] = $fields[2] = 'undef';
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print join(&quot;\t&quot;, @fields);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next;
&nbsp;&nbsp;&nbsp;&nbsp;}

    # Sometimes the 'start' and 'end' coordinates from the Query sequence ARE keys in the
&nbsp;&nbsp;&nbsp;&nbsp;# %ncbi_coordinates_of hash, but the corresponding values from the Sbjct sequence are undef
&nbsp;&nbsp;&nbsp;&nbsp;# so continue processing gracefully when this occurs

&nbsp;&nbsp;&nbsp;&nbsp;$fields[1] = $ncbi_coordinates_of{$fields[1]} //= 'undef';
&nbsp;&nbsp;&nbsp;&nbsp;$fields[2] = $ncbi_coordinates_of{$fields[2]} //= 'undef';
&nbsp;&nbsp;&nbsp;&nbsp;print join(&quot;\t&quot;, @fields);
}
close $FH3;

exit;

Conclusion

When you run the script, save the output to file, and then use grep undef to see if there were any coordinates which could NOT be successfully mapped. If there are any then you can use grep -v undef to save a copy without those lines.

What did we learn? After running this script to create the new primer bed file for the NCBI RSVA RefSeq, and then rerunning their viral sequencing pipeline to align the amplified reads to the NCBI RefSeq, the bioinformaticians working with the infirmary could see that the two isolates from the workshop elves were more closely related than they had previously thought, but since the viruses still had many mutations separating them, it seemed like these were two separate exposures (or introductions) of RSVA to the North Pole compound.

You can see that for yourself in this image (which I generated using Nextstrain's excellent auspice.us tool for visualizing phylogenetic trees):

Image credit: Nextstrain.org (The UShER suite of tools for working with mutation annotated trees (MAT) has an option to generate JSON outputs pre-formatted for display at Nextstrain!)

N.B.: In accordance with the laws of Canada, Denmark, and Russia, the clinical metadata and any other personal health information (PHI) for these samples has been de-identified.

These are two versions of the RSVA Global phylogenentic tree, showing a subtree of the samples that the most highly related to the two sequences from Santa's workshop. The trees are shown rotated 90 degrees, so the "root" of the tree (which is not shown), is on the LEFT. You can see the "branches" as horizontal lines; and at the tips of each branch is a "leaf" (or a node). The leaves represent the sequences from different individual viruses in the database. Each tip is labeled with the name of the sample, and the two samples from the North Pole are colored black. The Y-axis has no units, and is arbitrary. The data depicting similarity is contained in the pattern of the branches (which are technically internal nodes), and in the LENGTH of the branches. The X-axis conveys information about the number of mutations in one sample, which is the number of nucleotide sequence changes that it takes to "get back" to the root of the tree.

Panel A. shows where the UShER program placed the two samples from the North Pole, using the Edinburgh RefSeq genome, whereas Panel B. shows where they were placed after the same samples were aligned to the NCBI RefSeq genome, and the new Primer bed file created with our script was used to remove (or trim) the primers from the end of the reads. You can see that the placement of the Elf_0001 sample is almost the same in the two trees, whereas the placement of the Elf_0002 sample has moved. It is now forking off at a different branch of the tree and is closer (and therefore more similar, or more related) to Elf_0001.

In principal, the flow and the steps used here could work with any paired RefSeqs for a pathogenic virus where you have created DNA sequencing amplicons with PCR primers from one coordinate system, but you want to be able to use your regular pipelines to align the fastq reads to a different RefSeq.

If you would like to test/replicate/hack the code above, here are links to the three input files I used:

If you have some paired-end fastq files from RSV (or another RNA virus) you can get an idea of the processing steps to use to generate consensus.fasta files here.

During the COVID19 Global Pandemic these consensus.fasta files were essential for constructing the phylogenetic trees used by Epidemiologists to identify outbreaks of new strains.

THM: Best to wear masks at the North Pole until after DEC-24.

Half My Life with Perl

2024-12-19T00:00:00Z

I had never met Randal Schwartz before, but when I reached out to him about contributing to year 25 of the Perl Advent Calendar, he immediately agreed. This year I wanted to try some new things and Randal suggested giving a Perl-specific talk which he had given once before, but which was lacking in recording quality. This gave Randal a chance to re-record his talk and it gave the Perl communities a chance to watch in real time. We've never before had a video recording as a Perl Advent article, but I believe quite strongly that this is in the spirit of the Advent Calendar project, which is about giving something back. Also, when I mentioned it to Mark Fowler back in October, he didn't object, so I'll take that as a seal of approval.

-- Olaf Alders

Randal's advance summary of this talk:

    Having been there, at the beginning with Perl, I will recount the early
    days through the modern era (or as much as I can cover in the time
    provided). I&rsquo;ll deliver first-hand experience of the creation of the Camel
    Book, the Llama book, and the way I invaded comp.unix.questions with Perl 2
    answers so often that people would post &ldquo;no Perl please&rdquo;. Oh, and my
    version of the story of the Schwartzian Transform.

If you enjoyed the video below, you may also enjoy the next in the series, which will be presented by Dave Cross: Still Munging Data with Perl. If you are at all interested, please register now, even if you cannot attend, as that will allow us to share the recording URL with you after the fact.

Now, please enjoy Randal Schwartz's "Half My Life with Perl":

Santa will be watching

2024-12-18T00:00:00Z

Another busy Christmas period loomed, and the North Pole was tirelessly working to get the final preparations ready. Inside a brightly lit meeting room Santa cleared his throat.

"This is all very interesting, very... *yawn* ...stimulating", he said, picking at some cookie crumbs that fell from his beard to the table. "But how is that going to help us? How does ... absorbability help us deliver gifts?"

"Observability", corrected Ada Slashdóttir, the team's senior elf.

"Yeah, that's what I said", said Santa. "What does it do for us?"

As their platform had started to grow, the elves had struggled to keep track on where the bottlenecks were. And now that they had migrated parts of it to microservices and their platform was becoming more distributed, even the tools they were familiar were starting to become unwieldy.

"We need to have a way to see from the outside how our system behaves internally, Santa", said Ada. "That's observability. So it doesn't directly help us send gifts, but it helps us keep things running smoothly, and that helps us send gifts".

"Isn't that what logs do?", asked Duende Juniorsson, the team's junior elf, who was trying to catch up. "We already have logs in our services. Can't we use those?"

Santa liked logs. Yule logs in particular.

"We can, for sure", said Gnomo Knullpointer, who had recently joined Santa's workshop as a coding elf. "Logs are useful because they have been around forever, so they are well supported. But they have their limitations, specially now that a single request can touch several separate microservices before we are done with it. We'd have to correlate logs across services, which is not easy."

"Correlating logs is difficult, but there are other kinds of telemetry we can use", said Ada. "In particular, we can uses traces to track a request across services. This is called 'distributed tracing'. Let me show you how it works."

Integrating with Mojolicious

Ada then opened the code for the Naught-or-Not service, a Mojolicious application that checked whether a specific child has been naughty or nice:

# Naught-or-Not: the 'naughty or nice' service
use Mojolicious::Lite -signatures;
use Mojo::SQLite;

helper sql =&gt; sub { state $sql = Mojo::SQLite-&gt;new };

app-&gt;sql-&gt;migrations-&gt;name('santa')-&gt;from_string(&lt;&lt;'EOF')-&gt;migrate;
-- 1 up
create table naughty (id integer unique, naughty bool);
-- 1 down
drop table naughty;
EOF

get '/is-naughty/:id' =&gt; sub ($c) {
&nbsp;&nbsp;&nbsp;&nbsp;my $id = $c-&gt;param('id');
&nbsp;&nbsp;&nbsp;&nbsp;my $db = app-&gt;sql-&gt;db;

    # If we have a value for this ID, return it

&nbsp;&nbsp;&nbsp;&nbsp;my $row = $db
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;select( naughty =&gt; ['naughty'] =&gt; { id =&gt; $id } )
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;hashes
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;first;

&nbsp;&nbsp;&nbsp;&nbsp;return $c-&gt;render( json =&gt; { naughty =&gt; $row-&gt;{naughty} } ) if $row;

    # Otherwise, generate one and store it before returning

&nbsp;&nbsp;&nbsp;&nbsp;my $naughty = !!( int rand 2 ); # Randomised naughtiness!

&nbsp;&nbsp;&nbsp;&nbsp;$db-&gt;insert( naughty =&gt; { id =&gt; $id, naughty =&gt; $naughty } );

&nbsp;&nbsp;&nbsp;&nbsp;$c-&gt;render( json =&gt; { naughty =&gt; $naughty } );
};

"The first thing we'll need to do", said Ada, "is get this code to start generating telemetry data. Traces in particular."

"Wait a second", said Gnomo. "If we start touching the code to generate this telemetry, we run the risk of introducing bugs. Not to mention that we have a lot of code, we'll never be able to do it all by hand..."

Santa was starting to sweat.

"We won't have to. We can use OpenTelemetry to do what is called 'zero code instrumentation', which will get us most of the way there. The first thing we'll need to do is load up the OpenTelemetry::SDK in our application. This will read the configuration from the environment and set things up internally so any telemetry we generate gets exported correctly. And since we are using Mojolicious we can use Mojolicious::Plugin::OpenTelemetry to actually generate telemetry data from our routes, all without actually touching any of the controller code."

use Mojolicious::Lite -signatures;
use OpenTelemetry::SDK;
use Mojo::SQLite;

plugin 'OpenTelemetry';

...

"And that's it?", asked Duende a little disappointed. He was already looking forward to touching a lot of code.

"Pretty much. The rest is just configuration. You can already see this in motion by running the code and telling it to export the traces to the console", said Ada, feeling pedagogic.

$ OTEL_TRACES_EXPORTER=console ./server get '/is-naughty/123'
[2024-12-16 23:24:29.37268] [821150] [trace] [nLc70JabTxup] GET &quot;/is-naughty/123&quot;
[2024-12-16 23:24:29.37288] [821150] [trace] [nLc70JabTxup] Routing to a callback
{
&nbsp;&nbsp;&nbsp;&nbsp;'attributes' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'client.address' =&gt; '127.0.0.1',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'client.port' =&gt; '47534',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'http.request.method' =&gt; 'GET',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'http.response.status_code' =&gt; 200,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'http.route' =&gt; '/is-naughty/:id',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'network.protocol.version' =&gt; '1.1',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'server.address' =&gt; '127.0.0.1',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'server.port' =&gt; '36703',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'url.path' =&gt; '/is-naughty/123',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'user_agent.original' =&gt; 'Mojolicious (Perl)'
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;'dropped_attributes' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;'dropped_events' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;'dropped_links' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;'end_timestamp' =&gt; '1734391469.37503',
&nbsp;&nbsp;&nbsp;&nbsp;'events' =&gt; [],
&nbsp;&nbsp;&nbsp;&nbsp;'instrumentation_scope' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'name' =&gt; 'server',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'version' =&gt; ''
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;'kind' =&gt; 2,
&nbsp;&nbsp;&nbsp;&nbsp;'links' =&gt; [],
&nbsp;&nbsp;&nbsp;&nbsp;'name' =&gt; 'GET /is-naughty/:id',
&nbsp;&nbsp;&nbsp;&nbsp;'parent_span_id' =&gt; '0000000000000000',
&nbsp;&nbsp;&nbsp;&nbsp;'resource' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.command' =&gt; './server',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.command_args' =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'get',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'/is-naughty/123'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.executable.name' =&gt; 'perl',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.executable.path' =&gt; '/home/user/.perl/perls/perl-5.40.0/bin/perl',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.pid' =&gt; 821150,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.runtime.name' =&gt; 'perl',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'process.runtime.version' =&gt; 'v5.40.0',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'telemetry.sdk.language' =&gt; 'perl',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'telemetry.sdk.name' =&gt; 'opentelemetry',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'telemetry.sdk.version' =&gt; '0.024'
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;'span_id' =&gt; '3823100b9ca26a91',
&nbsp;&nbsp;&nbsp;&nbsp;'start_timestamp' =&gt; '1734391469.3732',
&nbsp;&nbsp;&nbsp;&nbsp;'status' =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'code' =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'description' =&gt; ''
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;&nbsp;&nbsp;'trace_flags' =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;'trace_id' =&gt; '795c45630d3615ba1ebf524661bf01ac',
&nbsp;&nbsp;&nbsp;&nbsp;'trace_state' =&gt; ''
}

A wall of text (pretty printed here for clarity) appeared in front of the elves. Santa seized the opportunity to look like he knew what was going on by looking at the text in silence while thinking about what to have for lunch.

After a couple of seconds Gnomo and Duende had pieced it together. It was all there! Data about the request itself, how long it took, where it came from, and even details about what code had generated it... and all of that without having to touch any of the core logic!

"This is very cool", said Gnomo, who had been reading through OpenTelemetry::Guides::Quickstart and was already making sense of things. "And it seems we can get even more data if we load some of the instrumentation libraries that are already out there. This route uses a database, so we could use the OpenTelemetry::Instrumentation::DBI to get DBI to also generate telemetry".

use Mojolicious::Lite -signatures;
use OpenTelemetry::SDK;
use OpenTelemetry::Instrumentation 'DBI';
use Mojo::SQLite;

plugin 'OpenTelemetry';

...

Now running the test command printed even more output, this time including traces for all the DB operations, including the ones that executed when the service initially came up and ran the database migrations, etc.

"What about our other services? Not all of them are using Mojolicious", said Duende, thinking that maybe then he'd have the chance to touch some code.

Integrating with Dancer2

Ada loaded up the code for the Gift Allocation service, which was implemented in Dancer2. This service made a call to Naught-or-Not to check whether this child had been naughty, and allocated either a lump of coal or one of the gifts from the child's wishlist.

package Gift::Assignment;

use Dancer2;
use HTTP::Tiny;

set serializer =&gt; 'JSON';

my $ua = HTTP::Tiny-&gt;new;

post '/gift/assign' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $id = body_parameters-&gt;get('id');
&nbsp;&nbsp;&nbsp;&nbsp;my $res = $ua-&gt;get(&quot;$ENV{NAUGHT_OR_NOT_HOST}/is-naughty/$id&quot;);

&nbsp;&nbsp;&nbsp;&nbsp;unless ( $res-&gt;{success} ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;status $res-&gt;{status};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return { error =&gt; $res-&gt;{reason} };
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;my $body = decode_json $res-&gt;{content};
&nbsp;&nbsp;&nbsp;&nbsp;return { gift =&gt; 'coal' } if $body-&gt;{naughty};

&nbsp;&nbsp;&nbsp;&nbsp;my @wants = body_parameters-&gt;get_all('wants');
&nbsp;&nbsp;&nbsp;&nbsp;{ gift =&gt; $wants[ int rand @wants ] };
};

"Like with the Mojolicious service, integrating this with OpenTelemetry requires no code changes", said Ada. Duende's heart sank. Was he going to get to touch any code? "All we need to do is load the Dancer2::Plugin::OpenTelemetry plugin".

"And like with the DBI instrumentation, since this route is using an HTTP client, we can load OpenTelemetry::Instrumentation::HTTP::Tiny to get telemetry for the requests it makes!", chimed in Gnomo, who was neck-deep in the documentation for instrumentation libraries and getting very excited.

The import list now looked like this:

package Gift::Assignment;

use Dancer2;
use Dancer2::Plugin::OpenTelemetry;
use OpenTelemetry::Instrumentation 'HTTP::Tiny';

set serializer =&gt; 'JSON';

...

"Hold on a second... what happened to the HTTP::Tiny import?", asked Duende, who was trying to follow along to find ways to contribute.

"Oh, well that's done automatically when we load the instrumentation library, so we don't need to write that twice", said Ada".

"And what about the OpenTelemetry::SDK import? Don't we need it here as well?", continued Duende.

"Ah, well spotted, Duende!", replied Ada. "We do need it, but we only need to load it once. Since this service will have more controllers once it's finished, loading it in each one would be a hassle, so it's better to load it once at the entry point. In this case, since we are using Plack to mount it, we can load that in the top-level PSGI file".

#!/usr/bin/env perl

use strict;
use warnings;
use lib 'lib';

use Gift::Assignment;
use OpenTelemetry::SDK;
use Plack::Builder;

builder {
&nbsp;&nbsp;&nbsp;&nbsp;Gift::Assignment-&gt;psgi_app;
}

Once again they tested it. They brought up the server configured to send traces to the terminal, and made a request:

$ curl -X POST \
&nbsp;&nbsp;&nbsp;&nbsp;-H 'Content-Type: application/json' \
&nbsp;&nbsp;&nbsp;&nbsp;-d '{&quot;id&quot;:123, &quot;wants&quot;:[&quot;teddy_bear&quot;, &quot;crochet&quot;]}' \
&nbsp;&nbsp;&nbsp;&nbsp;http://localhost:5000/gift/assign

As the traces appeared in the logs now for both services, Gnomo spotted something. "Hey look! Ignore everything in the traces except for those span and trace IDs". Pretty printed for your convenience, this is what he was looking at:

    naught-or-not  | {
      &#39;name&#39; =&gt; &#39;SELECT &quot;naughty&quot; FROM &quot;naughty&quot; WHERE &quot;id&quot; = ?&#39;,
      &#39;parent_span_id&#39; =&gt; &#39;88b066b24f372f39&#39;,
      &#39;span_id&#39; =&gt; &#39;932cf74c171b705e&#39;,
      &#39;trace_id&#39; =&gt; &#39;16073bf43d281a0693ec7d5a9f4860a4&#39;,
    }
    naught-or-not  | {
      &#39;name&#39; =&gt; &#39;GET /is-naughty/:id&#39;,
      &#39;parent_span_id&#39; =&gt; &#39;7bd198e5a6ddd5fd&#39;,
      &#39;span_id&#39; =&gt; &#39;88b066b24f372f39&#39;,
      &#39;trace_id&#39; =&gt; &#39;16073bf43d281a0693ec7d5a9f4860a4&#39;,
    }
    gifts          | {
      &#39;name&#39; =&gt; &#39;GET&#39;,
      &#39;parent_span_id&#39; =&gt; &#39;d9718758cefd39d4&#39;,
      &#39;span_id&#39; =&gt; &#39;7bd198e5a6ddd5fd&#39;,
      &#39;trace_id&#39; =&gt; &#39;16073bf43d281a0693ec7d5a9f4860a4&#39;,
    }
    gifts          | {
      &#39;name&#39; =&gt; &#39;POST /gift/assign&#39;,
      &#39;parent_span_id&#39; =&gt; &#39;0000000000000000&#39;,
      &#39;span_id&#39; =&gt; &#39;d9718758cefd39d4&#39;,
      &#39;trace_id&#39; =&gt; &#39;16073bf43d281a0693ec7d5a9f4860a4&#39;,
    }

Santa wondered if this is what it felt like to see the woman in the red dress.

"What are we looking at?", said Duende.

"They are all linked!", replied Gnomo excitedly. "They have the same trace_id, and the parent_span_id in each one is the same as the span_id of the one that came before it, which appears lower in the logs".

"Well, except for that one at the bottom. That one just has a bunch of zeroes as the parent_span_id", commented Duende.

"Yes, that is called the root span", said Ada. "The fact that it has a null parent_span_id tells us that this is the span that initiated the trace".

"We could write something that would aggregate these data and present them in a neater way", said Gnomo. "Maybe something using a kind of flamegraph like the ones from Devel::NYTProf, which are great".

"We don't have to!", said Ada. "The OpenTelemetry project has already done that for us. We can use the OpenTelemetry Collector to aggregate all sorts of telemetry data generated via OpenTelemetry and then configure it to send that data to whatever external service or platform we want".

"Oh, so it's vendor agnostic too?", said Gnomo. "That's very good".

Santa's eye twitched at the mention of "agnostic". This was a touchy subject in the North Pole. He looked at Helga Hakrniüs, the Public Relations elf in the corner of the room who quietly shook their head. Santa let his breath out and wiped his brow.

"Yes, that's one of OpenTelemetry's key selling points", said Ada. "Vendor agnostic on the consumer side, and platform agnostic on the producer side, so you can use it in services written not only in all sorts of frameworks like we just saw, but also in all sorts of languages. They even have a demo application where you can see this in motion".

"Is this true for Perl as well?", said Gnomo. "We can obviously use it in Mojolicious and Dancer2, but what about other frameworks, like Catalyst? I heard that's what the Milk-and-Cookies team was using for their service. Or plain CGI? We still have a bunch of those in the older parts of the code".

"Yes!", said Ada. "The Perl implementation is relatively new, so there's still work to do, but we do have Plack::Middleware::OpenTelemetry that we can use for any server that uses Plack. The integration might not be as close, but it does work. And it's only a matter of time before more instrumentation libraries get released".

"So how do we use this Collector?", asked Duende.

"I'm glad you asked", replied Ada.

From the terminal to the browser

"The OpenTelemetry distribution on CPAN has an example collector stack that we can use to see how things go together", continued Ada. "There is also a similar example managed by the developers of the collector itself, and a more realistic example in the OpenTelemetry demo I mentioned before. We can use the one from CPAN to illustrate things for now".

git clone https://github.com/jjatria/perl-opentelemetry
cd perl-opentelemetry/examples/collector
docker compose up --build

"And then we tell the services to talk to it?", asked Gnomo.

"Yes", said Ada. "We need to set a couple of environment variables for each deployment so that they can talk to the collector. It's probably easier to show this with a docker compose file".

services:
&nbsp;&nbsp;naught-or-not:
&nbsp;&nbsp;&nbsp;&nbsp;build:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;context: mojo
&nbsp;&nbsp;&nbsp;&nbsp;container_name: naught-or-not
&nbsp;&nbsp;&nbsp;&nbsp;volumes:
&nbsp;&nbsp;&nbsp;&nbsp;- ./mojo:/app
&nbsp;&nbsp;&nbsp;&nbsp;command:
&nbsp;&nbsp;&nbsp;&nbsp;- hypnotoad
&nbsp;&nbsp;&nbsp;&nbsp;- ./server
&nbsp;&nbsp;&nbsp;&nbsp;- --foreground
&nbsp;&nbsp;&nbsp;&nbsp;environment:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IO_ASYNC_LOOP: Mojo
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_BSP_MAX_EXPORT_BATCH_SIZE: 1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_EXPORTER_OTLP_ENDPOINT: http://localhost
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_SERVICE_NAME: naught-or-not
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_TRACES_EXPORTER: otlp
&nbsp;&nbsp;&nbsp;&nbsp;network_mode: host

&nbsp;&nbsp;gifts:
&nbsp;&nbsp;&nbsp;&nbsp;build:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;context: dancer
&nbsp;&nbsp;&nbsp;&nbsp;container_name: gifts
&nbsp;&nbsp;&nbsp;&nbsp;volumes:
&nbsp;&nbsp;&nbsp;&nbsp;- ./dancer:/app
&nbsp;&nbsp;&nbsp;&nbsp;command:
&nbsp;&nbsp;&nbsp;&nbsp;- plackup
&nbsp;&nbsp;&nbsp;&nbsp;- --server
&nbsp;&nbsp;&nbsp;&nbsp;- Net::Async::HTTP::Server
&nbsp;&nbsp;&nbsp;&nbsp;- ./server.psgi
&nbsp;&nbsp;&nbsp;&nbsp;environment:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;NAUGHT_OR_NOT_HOST: http://localhost:8080
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_BSP_MAX_EXPORT_BATCH_SIZE: 1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_EXPORTER_OTLP_ENDPOINT: http://localhost
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_SERVICE_NAME: gifts
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;OTEL_TRACES_EXPORTER: otlp
&nbsp;&nbsp;&nbsp;&nbsp;network_mode: host

"In both cases we need to set OTEL_SERVICE_NAME to something meaningful so we can identify where the traces come from. We also need to set OTEL_TRACES_EXPORTER to otlp, which is the protocol used by the collector, and OTEL_EXPORTER_OTLP_ENDPOINT to the host that we are sending the telemetry to. In this case, both of these are set to their default values, but it's good for now to be explicit".

"What about that OTEL_BSP_MAX_EXPORT_BATCH_SIZE?", asked Duende. He had already learned the hard way that a batch of one was a little pointless.

"Oh, that's only for testing. In a realistic scenario we can increase that to limit the number of requests that we make to the collector", said Ada.

"So the communication with the collector happens off-band?", asked Gnomo.

"Yes. When exporting to the console we got each span as it was produced, but in a production environment you'd expect many times more spans to be produced, and it would be very expensive to export each one as it came. It's more efficient to batch them and send them all together when enough of them are ready. The Perl OpenTelemetry implementation uses a batch span processor written on top of IO::Async to do this".

Santa wondered if his elves lived in the same planet as he did. He was glad there were people in the room who knew about this so he didn't have to.

"Is that why we need the IO_ASYNC_LOOP variable in the Mojolicious environment?", asked Gnomo.

"Yes", said Ada. "We need that because Mojolicious has its own event loop, so we need to tell IO::Async to use it".

"I see. And that's why in the Dancer2 environment we use Net::Async::HTTP::Server, because Dancer2 doesn't have an event loop, and this gives it one", said Gnomo.

"Exactly", said Ada. "And now, if we run this so it talks to the collector stack, and make some queries, we can see the traces in our browser. That stack connects the collector to a Jaeger instance, which we should be able to see at http://localhost:16686".

"Incidentally", said Ada, "I've put all the files for what we've been talking about in a repository you can check out if you want to run things yourself".

Santa was happy to finally be able to see some pretty pictures. And as he looked at his elves, all excitedly looking around and exploring the data, he felt a warm sense of pride and joy to see them learning and growing and getting things done.

With this out of the way, he could finally get back to what mattered most: having those milk and cookies.

Annotating Christmas Trees

2024-12-17T00:00:00Z

Lesser-known businesses

Everybody knows that the North Pole™ produces and delivers Christmas gifts, but it’s not the sole business they’re into. In fact, they’ve recently engaged in production of Christmas ornaments and Christmas cards, too.

As is common, starting a new business brings new problems. The elves needed a way to design decorated Christmas trees to evaluate their ornament proposals and their combinations. They started by planting small trees and decorating them by hand, but quickly found out this approach didn’t scale as more and more (and bigger and bigger) trees were needed.

At a C-level meeting, Santa listened to laments of the managing elf responsible for the ornaments and narrowed his eyes at another young elf at the other corner of the table.

“You had something for arranging trees, right?” asked Santa.

“Yes, but…” spluttered the elf.

“Let’s meet after lunch and see how we can share the knowledge,” commanded Santa.

There’s trees and there’s trees

In the afternoon (by the way, it was already dark, since it was the North Pole and summer was over) Santa met with the COO and CCO (where the second letter stands for Ornaments or Cards, respectively).The CBO (Chief Baubles Officer) was missing as his department was merged with the Ornaments in the last workforce shaping to trim the fat.

“Can you show us what your department uses to visualise trees?” asked Santa, turning to the CCO.

“Our developers found this open source tool called TrEd, which stands for ‘Tree Editor’,” replied the elf. “And they’re still discovering new features it has. You can do much more than view the trees: you can easily change their structure, add attributes to nodes and edges, add secondary relations that turn the trees into full graphs, and there are also tools for searching large treebanks.”

“I hate the jargon,” muttered Santa and turned to the COO, “but I guess you’re following.”

“Actually, not really,” replied the COO, “we need to arrange the ornaments, but we don’t want to change the structure of the trees. How is such a thing needed to produce a Christmas card, anyway?”

“We hear similar questions often,” said the CCO keeping a stiff upper lip. “At the beginning, we only produced English Christmas cards, so we didn’t need anything like that. But several years ago we started printing the cards in other languages, too, and we needed a way to translate all the greetings and wishes. We started with elvish translators, but we found ourselves in your boots, so to say: the approach didn’t scale.

“We needed an automated process. We reached for statistical machine translation, but for that, we needed large aligned corpora in both the source and target languages.”

“Corpora?” asked Santa raising an eyebrow.

“Large collections of texts. And we quickly found out aligning the individual words wasn’t enough, as the grammar in various languages can change the words in different roles. The sentence structure stays usually much more similar across languages than individual words and their order. That’s why we started annotating the trees.”

“Decorating,” said Santa and nodded to the COO hopefully.

“No, annotating,” explained the CCO. “I’m talking about trees in the graph-theory sense. We arrange the words in a sentence to a tree and annotate the relations between them with their syntactic roles: this word is a subject of this verb, that word is an adverbial of that word,” and he started to gesticulate wildly.

“Wait, wait,” the COO interrupted him, “can you show us what you’re talking about? I still have no idea.”

“Ho ho ho,” said Santa, “a picture is worth a thousand words!”

Diving deeper

The CCO opened his ChristmasPad and typed something into a terminal. “See? This is Ukrainian, by the way.”

“That’s impressive,” admitted Santa, “but I fear there’s some kind of confusion.”

“Let’s have a look at a simpler example in English,” replied the CCO and quickly typed on the keyboard. “The annotated sentence is Is that Microwave that you gave Dan really expensive?”

“You can see the pronoun that references the word microwave, and the word microwave is an object of the verb give in a semantic sense which we can also capture.”

“No, no,” tried Santa to stop him, “linguistics is not our concern.”

“That”s great!” rejoiced the CCO. “I’ve always wondered whether TrEd can be used outside of linguistics. There already is one such use: The tree editor serves as a client to a search engine. You assemble a tree and the engine searches your tree data to find where the tree would fit. The trick is you can specify different relations than the ordinary parent–child one.”

“Ho ho ho,” nodded Santa, “Christmas is a family time!”.

“I mean this,” explained the CCO and again showed them his screen.

“Normally, the parent would be at the top, but here, we’re using the reversed relation, so the query will search for all nominal subjects whose parent is not a verb.”

“How can something that’s not a verb have a subject?” wondered Santa.

“Let me show you the English example with the microwave again. The Universal Dependencies style uses adjectives in copula constructions as parents of the subject and the auxiliary verb. The word expensive is not a verb, but the microwave is its nominal subject.”

“I fear this whole thing is of no use for us,” sighed the COO. “What programming language is the tool written in?”

“Perl,” replied the CCO. “It uses Tk::Canvas to edit the trees, which makes it rather easy to extend if you need more features.”

“At least something our team would understand. And the search engine is also written in Perl?” asked the COO again.

“There are in fact two implementations,” replied the CCO. “One uses SQL on Postgres to store and query the data, but it’s only suitable for data that don’t change, as updating the database is quite slow. The second implementation uses Perl and is great for querying frequently changing data. If the data are large, you need some kind of parallelism to compensate its less favourable speed, we run it over slurm. But you can also write your queries directly in Perl. This will show you exactly the same trees as the query I showed you before.” And he again used the terminal.

btred -N -T -e '
&nbsp;&nbsp;&nbsp;&nbsp;FPosition()
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if $this-&gt;{deprel} eq &quot;nsubj&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&amp;&amp; $this-&gt;parent-&gt;{upostag} ne &quot;VERB&quot;
&nbsp;&nbsp;&nbsp;&nbsp;' data/*.conllu | tred -l-

“Also, if you need to process the data without all the power TrEd offers, you can just use Treex::PML, the library that TrEd is based on. It implements the Prague Markup Language used as TrEd’s native data format. The previous five-liner turns almost into a screenful,” and he opened Elven Mate at Creating Scripts (EMaCS) and started to type, interrupted several times by squinting into the documentation.

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

my $ud_path;
BEGIN { $ud_path = $ENV{UD_DIR} }

use lib &quot;$ud_path/libs&quot;;

use Treex::PML qw{ ImportBackends AddResourcePath };

my @backends = ImportBackends('UD');
AddResourcePath(&quot;$ud_path/resources&quot;);

my $schema = 'Treex::PML::Factory'-&gt;createPMLSchema({
&nbsp;&nbsp;&nbsp;&nbsp;use_resources =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;filename      =&gt; &quot;ud_schema.xml&quot;});

for my $file (@ARGV) {
&nbsp;&nbsp;&nbsp;&nbsp;my $doc = 'Treex::PML::Factory'-&gt;createDocumentFromFile(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$file, {backends =&gt; \@backends});

&nbsp;&nbsp;&nbsp;&nbsp;my $tree_no = 1;
&nbsp;&nbsp;&nbsp;&nbsp;for my $tree ($doc-&gt;trees) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $node_no = 1;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for my $node ($tree-&gt;descendants) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;say &quot;$file##$tree_no.$node_no&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if $node-&gt;{deprel} eq &quot;nsubj&quot;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&amp;&amp; $node-&gt;parent-&gt;{upostag} ne &quot;VERB&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;++$node_no;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;++$tree_no;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

No happy ending?

“It’s interesting, but I don’t see how our department could benefit from it,” shrugged the COO.

Santa seemed lost in thought. “Maybe your department can’t,” murmured he, “but we have many other departments that need solutions…”

He dismissed the meeting by pointing at the door and strode towards his office. Can you think of a way how you could benefit from the tool?

Merry Inline C(hristmas)

2024-12-16T00:00:00Z

Dancing through the Cnow

It is this time of the year, the time you have finally some time to catch up finishing the projects you were supposed to do the previous months. A blizzard of C code, like the arrows in the movie 300 will descend upon you if you do, but you will end up in the naughty list of researchers if you don't; for who will analyze your data if YOU drop the ball? But fear not, because Inline::C will save the day and Perl will make the glaCiers melt away.

For the last couple of years, I have been using Inline::C to leverage a large amount of C code related to biological sequence (text) analysis for my research work. Our group has been using portable sequencing technologies by Oxford Nanopore to measure RNA molecules in real-time as markers of kidney disease progression. The problem we are facing is that understanding the data is not trivial, and many traditional bioinformatic workflows need considerable adaptation to work. Often, one has to combine exotic pieces of code that is available in C libraries into complex workflows that are non standard and require one to use the power of Perl to glue them together. Let's C how Inline::C can help us with the mess.

To A or not to A?

The molecules I am interested at have a tail of A's at the end of the sequence, e.g. something line ACTGCCATCAAGAAAAAAAAAAAAA , but the A's are irrelevant to the analysis I want to do. Often there are errors in the text, so that the sequence is not perfect, e.g. one is looking at something like this ACTGCCATCAAGAAAAAAAAAAAAAAGTAACAAAA. The question is, how can I remove the A's at the end of the sequence knowing that the error exists? There is a Python program cutadapt, for this task, but note why I don't want to use it for my tasks:

I will have to fire off another process, which is slow
I will have to use the hard disk and pipes for IPC (slow)
My downstream data analyses take place in Perl and C, so I will have to convert the data back and forth

Let's C how we can filter the noisy A's in Perl and then how we can add performance with Inline::C.

Regex for noisy A's

The general idea here is to use a regex that puts an upper limit to the proportion of errors in the A tails of the sequence. For example something like this:

my $polyA_min_25_pct_A = qr/
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;( ## match a poly A tail which is
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## delimited at its 5' by *at least* one A
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;A{1,}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## followed by the tail proper which has a
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?:     ## minimum composition of 25% A, i.e.
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## we are looking for snippets with
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## up to 3 CTGs followed by at
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## least one A
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[CTG]{0,3}A{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;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;|     ## OR
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(?:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## at least one A followed by
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;## up to 3 CTGs
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;A{1,}[CTG]{0,3}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)+    ## extend as much as possible
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)\z/xp;

# and then use it like this:
my $s = &quot;ACTGCCATCAAGAAAAAAAAAAAAAAGTAACAAAA&quot;;
$s =~ m/$$polyA_min_25_pct_A/;
my $best_index = length $1;

when one runs the code above, the $best_index will be 29, i.e. the regex filtered out everything after: ACTGCC

The cutadapt algorithm does not use a regex, but a simple scoring system to decide when to stop adding letters to the inferred tail. In particular, the algorithm considers all possible suffixes in the sequence of interest, and after filtering those that have more than 20% non-A letters, returns the position of the suffix with the largest score as the beginning of the tail. The algorithm in Perl is shown below:

sub perl_cutadapt {
&nbsp;&nbsp;my $s          = shift;
&nbsp;&nbsp;my $n          = length $s;
&nbsp;&nbsp;my $best_index = $n;
&nbsp;&nbsp;my $best_score = my $score = 0;
&nbsp;&nbsp;foreach my $i ( reverse( 0 .. $n - 1 ) ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $nuc = substr $s, $i, 1;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$score += $nuc eq 'A' ? +1 : -2;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if ( $score &gt; $best_score ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$best_index = $i;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$best_score = $score;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;}
&nbsp;&nbsp;$best_index = $n - $best_index;
&nbsp;&nbsp;if ( $best_score &lt; 0.4 * ( $best_index + 1 ) ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$best_index = $n;
&nbsp;&nbsp;}
&nbsp;&nbsp;return $best_index;
}

The A part is deemed to be 23 letters long and the non-A part is inferred to be ACTGCCATCAAG

Inline::C for performance

The algorithm as implemented is not very fast, and for large or many sequences it can be very slow. But as we will C, we can use Inline::C to speed things up. The C code is shown below:

use Inline (
&nbsp;&nbsp;&nbsp;&nbsp;C         =&gt; 'DATA',
);
say _cutadapt_in_C($s);

__DATA__;
__C__


#include &lt;stdlib.h&gt;
#include &lt;string.h&gt;
#include&lt;stdio.h&gt;
#include &lt;math.h&gt;

int _cutadapt_in_C(char *s) {
&nbsp;&nbsp;&nbsp;&nbsp;int n = strlen(s);
&nbsp;&nbsp;&nbsp;&nbsp;int best_index = n;
&nbsp;&nbsp;&nbsp;&nbsp;int best_score = 0;
&nbsp;&nbsp;&nbsp;&nbsp;int score = 0;
&nbsp;&nbsp;&nbsp;&nbsp;for (int i = n - 1; i &gt;= 0; i--) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;char nuc = s[i];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (nuc == 'A') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;score += 1;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;score -= 2;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (score &gt; best_score) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;best_index = i;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;best_score = score;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;best_index = (best_score &lt; -0.4 * (best_index + 1)) ? n : n - best_index;
&nbsp;&nbsp;&nbsp;&nbsp;return best_index;

}

But how fast is fast? Let's run a benchmark using different sequence lengths and fixing the length of the A tail to be 20% of the sequence length. The results (mean and standard deviation in microseconds over 2000 repetitions for each length) are shown below (the benchmarking code may be found in the /scripts directory of Bio::SeqAlignment::Examples::TailingPolyester):

| Algorithm    | Language | Target Sequence Length |                    |                   |                 |
|--------------|----------|------------------------|--------------------|-------------------|-----------------|
|              |          | 100                    | 1000               | 2000              | 10000           |
|--------------|----------|------------------------|--------------------|-------------------|-----------------|
| cutadapt     | Perl     | 16.0&plusmn;2.5               | 150.0&plusmn;11.1         | 310.0&plusmn;21.0        | 1500.0&plusmn;88.0     |
| regex        | Perl     | 26.0&plusmn;10.0              | 310.0&plusmn;26.0         | 620.0&plusmn;42.0        | 3200.0&plusmn;140.0    |
| cutadaptC    | Perl/C   | 0.6&plusmn;1.0                | 3.1&plusmn;1.1            | 6.0&plusmn;1.4           | 28.0&plusmn;4.3        |

A nice 30-50x speedup for the C code over the Perl code. The savings are real, considering that a typical long RNA-seq experiment may have 10^6 - 10^7 reads, and each read may have a length of 1000 bases.

Making memories this C(hristmas)

The C code is not very complex, but it is a good example of how one can use Inline::C to speed up tasks. But the module can help with more than that. For example, one can use it to interface with other foreign code, by making and managing shared memory regions. Consider an example, in which we hijack the Newxz and Safefree functions from the Perl API to allocate and free memory areans to make $memory. Such a variable is effectively a pointer to a memory arena, and we can use it to store and retrieve data from it. Suppose that one had a library that took such an arena as input and filled it with data. Then the arena could dance with any other library that expected a pointer to a memory arena. The library could be written in C, or Assembly. For example, this is how one can sum lots and lots of random numbers using either C or Assembly, under the loving embrace of Perl working with Inline::C:

use Inline (
&nbsp;&nbsp;&nbsp;&nbsp;C         =&gt; 'DATA',
);
use Inline (
&nbsp;&nbsp;&nbsp;&nbsp;C         =&gt; 'DATA',
);
my $number_of_doubles = 2_000_000;
my $memory = alloc_with_Newxz($number_of_doubles*8);
generate_random_double_array($memory, $number_of_doubles);

use Benchmark qw(:all);
cmpthese(
&nbsp;&nbsp;&nbsp;&nbsp;-1,
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'C' =&gt; sub { sum_array_C($memory, $number_of_doubles) },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'ASM' =&gt; sub { sum_array_doubles($memory, $number_of_doubles) },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'ASM_AVX' =&gt; sub { sum_array_doubles_AVX_unaligned($memory, $number_of_doubles) },
&nbsp;&nbsp;&nbsp;&nbsp;}
);

free_with_Safefree($memory);


use Inline
ASM     =&gt; 'DATA',
AS      =&gt; 'nasm',
ASFLAGS =&gt; '-f elf64',
PROTO   =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;sum_array_doubles=&gt; 'double(void *,size_t)',
&nbsp;&nbsp;&nbsp;&nbsp;sum_array_doubles_AVX_unaligned =&gt; 'double(void *,size_t)',

};


__DATA__;
__C__


#include &lt;stdlib.h&gt;
#include &lt;string.h&gt;
#include&lt;stdio.h&gt;
#include &lt;math.h&gt;


int _cutadapt_in_C(char *s) {
&nbsp;&nbsp;&nbsp;&nbsp;int n = strlen(s);
&nbsp;&nbsp;&nbsp;&nbsp;int best_index = n;
&nbsp;&nbsp;&nbsp;&nbsp;int best_score = 0;
&nbsp;&nbsp;&nbsp;&nbsp;int score = 0;
&nbsp;&nbsp;&nbsp;&nbsp;for (int i = n - 1; i &gt;= 0; i--) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;char nuc = s[i];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (nuc == 'A') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;score += 1;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;score -= 2;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (score &gt; best_score) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;best_index = i;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;best_score = score;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;best_index = (best_score &lt; -0.4 * (best_index + 1)) ? n : n - best_index;
&nbsp;&nbsp;&nbsp;&nbsp;return best_index;

}

#define IsSVValidPtr(sv)  do { \
&nbsp;&nbsp;&nbsp;&nbsp;if (!SvOK((sv))) { \
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;croak(&quot;Pointer is not defined&quot;); \
&nbsp;&nbsp;&nbsp;&nbsp;} \
&nbsp;&nbsp;&nbsp;&nbsp;if (!SvIOK((sv))) { \
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;croak(&quot;Pointer does not contain an integer&quot;); \
&nbsp;&nbsp;&nbsp;&nbsp;} \
&nbsp;&nbsp;&nbsp;&nbsp;IV value = SvIV((sv)); \
&nbsp;&nbsp;&nbsp;&nbsp;if (value &lt;= 0) { \
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;croak(&quot;Pointer is negative or zero&quot;); \
&nbsp;&nbsp;&nbsp;&nbsp;} \
} while(0)

#define SetTypedPtr(ptr,sv, type) type *ptr; \
&nbsp;&nbsp;&nbsp;&nbsp;ptr = (type *) SvIV((sv))


void generate_random_double_array(SV *sv, size_t num_elements) {
&nbsp;&nbsp;&nbsp;&nbsp;IsSVValidPtr(sv);
&nbsp;&nbsp;&nbsp;&nbsp;SetTypedPtr(array, sv, double);
&nbsp;&nbsp;&nbsp;&nbsp;for (size_t i = 0; i &lt; num_elements; ++i) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;array[i] = ((double)rand() / RAND_MAX) * 10.0 - 5.0;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

double sum_array_C(SV *sv, size_t length) {
&nbsp;&nbsp;&nbsp;&nbsp;IsSVValidPtr(sv);
&nbsp;&nbsp;&nbsp;&nbsp;double sum = 0.0;
&nbsp;&nbsp;&nbsp;&nbsp;SetTypedPtr(array, sv, double);
&nbsp;&nbsp;&nbsp;&nbsp;for (size_t i = 0; i &lt; length; i++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sum += array[i];
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;return sum;
}



// get a buffer
SV* alloc_with_Newxz(size_t length) {
&nbsp;&nbsp;&nbsp;&nbsp;char* array ;
&nbsp;&nbsp;&nbsp;&nbsp;Newxz(array, length, char);
&nbsp;&nbsp;&nbsp;&nbsp;return newSVuv(PTR2UV(array));
}

void free_with_Safefree(size_t address) {
&nbsp;&nbsp;&nbsp;&nbsp;void* buffer = (void*)address;
&nbsp;&nbsp;&nbsp;&nbsp;Safefree(buffer);
}


__ASM__
NSE    equ 4 ; number of SIMD double elements per iteration
DOUBLE equ 8 ; number of bytes per double
; Use RIP-relative memory addressing
default rel

; Mark stack as non-executable for Binutils 2.39+
section .note.GNU-stack noalloc noexec nowrite progbits

SECTION .text

global sum_array_doubles
sum_array_doubles: ; based on Kusswurm listing 5-7c
&nbsp;&nbsp;&nbsp;&nbsp;; Initialize
&nbsp;&nbsp;&nbsp;&nbsp;vxorpd xmm0, xmm0, xmm0 ; sum = 0.0
&nbsp;&nbsp;&nbsp;&nbsp;sub rdi, DOUBLE              ; rdi = &amp;array[-1]

&nbsp;&nbsp;&nbsp;&nbsp;Loop1:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;add rdi, DOUBLE
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vaddsd xmm0, xmm0, qword [rdi]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub rsi, 1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;jnz Loop1
&nbsp;&nbsp;&nbsp;&nbsp;ret


global sum_array_doubles_AVX_unaligned
sum_array_doubles_AVX_unaligned: ; based on Kusswurm listing 9-4d
&nbsp;&nbsp;&nbsp;&nbsp;vxorpd ymm0, ymm0, ymm0         ; sum = 0.0

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;; i = 0 in the comments of this block
&nbsp;&nbsp;&nbsp;&nbsp;lea r10,[rdi - DOUBLE]          ; r10 = &amp;array[i-1]
&nbsp;&nbsp;&nbsp;&nbsp;cmp rsi, NSE                    ; check if we have at least NSE elements
&nbsp;&nbsp;&nbsp;&nbsp;jb Remainder_AVX                ; if not, jump to remainder
&nbsp;&nbsp;&nbsp;&nbsp;lea r10, [rdi-NSE * DOUBLE]     ; r10 = &amp;array[i-NSE]


&nbsp;&nbsp;&nbsp;&nbsp;Loop1_AVX:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;add r10, DOUBLE * NSE        ; r10 = &amp;array[i]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vaddpd ymm0, ymm0, [r10]     ; sum += array[i]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub rsi, NSE                 ; decrement the counter
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;cmp rsi, NSE                 ; check if we have at least NSE elements
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;jae Loop1_AVX                ; if so, loop again

&nbsp;&nbsp;&nbsp;&nbsp;; Reduce packed sum using SIMD addition
&nbsp;&nbsp;&nbsp;&nbsp;vextractf128 xmm1, ymm0, 1      ; extract the high 128 bits
&nbsp;&nbsp;&nbsp;&nbsp;vaddpd xmm2, xmm1, xmm0         ; sum += high 128 bits
&nbsp;&nbsp;&nbsp;&nbsp;vhaddpd xmm0, xmm2, xmm2        ; sum += low 128 bits
&nbsp;&nbsp;&nbsp;&nbsp;test rsi, rsi                   ; check if we have any elements left
&nbsp;&nbsp;&nbsp;&nbsp;jz End_AVX                      ; if not, jump to the end

&nbsp;&nbsp;&nbsp;&nbsp;add r10, DOUBLE * NSE  - DOUBLE ; r10 = &amp;array[i-1]


&nbsp;&nbsp;&nbsp;&nbsp;; Handle the remaining elements
&nbsp;&nbsp;&nbsp;&nbsp;Remainder_AVX:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;add r10, DOUBLE
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vaddsd xmm0, xmm0, qword [r10]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sub rsi, 1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;jnz Remainder_AVX

&nbsp;&nbsp;&nbsp;&nbsp;End_AVX:
&nbsp;&nbsp;&nbsp;&nbsp;;vmovsd xmm0, xmm5
&nbsp;&nbsp;&nbsp;&nbsp;ret

In this example we make 2 million of doubles, fill them up with random numbers and then benchmark their sum them up in either C or Assembly. For the latter we can use your grandfather's era Assembly or bring to the table a vectorized version that uses SIMD instructions (in this case AVX extensions). In my old Xeon, this is what I get:

          Rate     ASM       C ASM_AVX
ASM      565/s      --     -0%    -68%
C        565/s      0%      --    -68%
ASM_AVX 1778/s    215%    215%      --

In my applications, I use this trick to interface with vectorized, hand optimized Assembly code, when intrinsics fail to deliver performance in C. But even in such cases, the memory management is done by Perl through Inline::C.

Conclusions

Give your self a present this C(hristmas) and learn how to use Inline::C to speed things up. And if making memories seems too much, fear not, the Task::MemManager module that I wrote up, will cut you some slaCk.

Perl, my child, is love in Github Actions

2024-12-15T00:00:00Z

Santa saw Christmas was approaching and there was so much stuff to do already. A lot of it had to do with quality assurance: were the newsletters added properly to the repository? Did those newsletter include whatever needed to be included in the first place? Were they properly formatted?

As any self-respecting Christmas-coding shop, Santa used GitHub. And needed to set up the QA pipelines properly. And fast. With Perl. And what's best to have stuff dome quickly? Like tinsel in Christmas, boilerplate is what takes you there.

Let's talk a bit about GitHub Actions

There are several kinds of GitHub actions. You can create them using a Docker container or JavaScript. But there's a third kind called composite actions.

A composite action essentially is a combination of several steps that might include other actions or running scripts. You can basically include the whole action in a single file, like this.

name: 'Hello Perl'
description: 'Simplest Perl composite action'
branding:
&nbsp;&nbsp;icon: 'briefcase'
&nbsp;&nbsp;color: 'blue'
inputs:
&nbsp;&nbsp;action-input:
&nbsp;&nbsp;&nbsp;&nbsp;description: 'What it is about'
&nbsp;&nbsp;&nbsp;&nbsp;required: false # or not
&nbsp;&nbsp;&nbsp;&nbsp;default: 'World'
runs:
&nbsp;&nbsp;using: &quot;composite&quot;
&nbsp;&nbsp;steps:
&nbsp;&nbsp;&nbsp;&nbsp;- run: print %ENV;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;shell: perl {0}
&nbsp;&nbsp;&nbsp;&nbsp;- name: Print input
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;env:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;TEMPLATE_INPUT: ${{ inputs.action-input}}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;run: print $ENV{'ACTION_INPUT'}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;shell: perl {0}

This is a very basic action.yml file, that placed in your main directory will simply print the environment variables to your GitHub actions visible log. Not a great deal, useful if you want to know the values of certain variables. But it can be used as first steps to any action, to debug it... and it uses Perl to do so.

It's not very widely known, but you can add a shell key to any step in a GitHub action so that it interprets whatever is in the run step; the {0} will be substituted by the name of a (I guess) temporal file that contains the step. So this is kinda

    perl possibly_temporary_file_that_contains_print_ENV.pl

(It might create a temporary file with a shebang and run it, TBH I don't know)

But see, we're not using any kind of container or downloaded module or anything else. Just the very basic stuff that's already there in the Ubuntu runner (and, as far as I can tell, in other runners too).

You can go ahead and test it this way:

name: Run basic action
on:
&nbsp;&nbsp;push:
jobs:
&nbsp;&nbsp;test:
&nbsp;&nbsp;&nbsp;&nbsp;runs-on: ubuntu-latest
&nbsp;&nbsp;&nbsp;&nbsp;name: Run basic action
&nbsp;&nbsp;&nbsp;&nbsp;steps:
&nbsp;&nbsp;&nbsp;&nbsp;- name: Run basic test
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;uses: JJ/perl-advent-2024-test-action-1@main

(or whatever else you named it). It will simply print a wall of environment variable names and values, badly formatted. But the point is, it just works and it's fast since it's not using anything that's not already in the Ubuntu runner.

Who said badly formatted? Maybe we can do it better? Right-on, let's use JSON::PP. Change the last step in action.yml to:

&nbsp;- run: |
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;use JSON::PP;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print JSON::PP-&gt;new-&gt;ascii-&gt;pretty-&gt;allow_nonref-&gt;encode( \%ENV );
&nbsp;&nbsp;&nbsp;shell: perl {0}

This is going to be a bit nicer. But what gives? We're not using CPAN. Right, there are quite a bit of CPAN modules already installed there, just like this one. Since perl is there, and cpan too, you will have at least any module that goes with any of them (CGI is no longer there, so you will not be able to deploy a website while your action is running). JSON::PP is one of those core modules, so no big deal. And no big time: this takes all of 0 seconds to run (OK, not really 0, but that's what's reported. Probably takes a small fraction of a second). Why would it take longer? All you need to run the action is already there, set up for you to use.

What else is in there? A probably incomplete list is here but I am not totally sure it's up to date; in fact, I know that LWP::Protocol::https has disappeared, so there is that. If I had to make broad categories of the modules we can find, there are the Debian configuration related modules, LWP and auxiliaries, git and HTML stuff, and odds and ends. There are enough goodies there that I would look first before installing something via cpan, which takes time, you need to set up a cache, and so on.

The caveat? All that is pretty much undocumented, so anything you rely on (as the above mentioned LWP::Protocol::https might disappear from one version of the runner to the next.

But there's a lot of boilerplate

Right-on, there is. Files need to be created, values need to be filled, and doing it from scratch can be cumbersome and CoPilot is not there to help you. No sweat. Just use this template for an action. Instantiate it, and hit the ground running.

In fact, there's a bit more there: a lib directory, a cpanfile and some other things. We'll get to that later. Meanwhile, let's return our attention to old Santa, who wants all his newsletters properly formatted, that is, the first line must contain a Markdown header: # followed by a space, and then a capital letter. A proper headline through and through.

We can do a proper module here to test our stuff. In the spirit of Unix (and Perl), we can do very simple actions, that take very little time, and which we can combine different ways or just run independently (like for instance this very useful -and underappreciated- action that just checks that the example in the README has the same version as the latest published one). So let's put the code that does the action in a module:

package Markdowner;

use feature 'signatures';

use parent Exporter;

our @EXPORT_OK = qw(headerOK);

sub headerOK( $fileContent ) {
&nbsp;&nbsp;return $fileContent =~ /^\#\h+[A-Z]/;
}

Just a simple regex to check what we said. But code that is not tested is broken, so let add a test:

use lib qw(lib ../lib);
use Markdowner qw(headerOK);

use Test::More;

for my $str ( (&quot;# Yes&quot;, &quot;#    FOO&quot;, &quot;# Bar&quot; )) {
&nbsp;&nbsp;ok( headerOK( $str ), &quot;«$str» is OK&quot; );
}

for my $badStr ( (&quot;#Yes&quot;, &quot;#    foo&quot;, &quot;#\nBar&quot; )) {
&nbsp;&nbsp;isnt( headerOK( $badStr ), 1, &quot;«$badStr» fails&quot; );
}

done_testing;

You might wonder why I'm using Test::More, which is deprecated-ish in favor of Test2::Bundle::More, instead of the latter. Along with why I'm using a feature pragma instead of the more precise use V5.36. Your questions will be answered in due time.

Because right next we will, or course, be testing this via Actions:

name: Perl tests

on:
&nbsp;&nbsp;push:
&nbsp;&nbsp;&nbsp;&nbsp;branches: '*'
&nbsp;&nbsp;pull_request:
&nbsp;&nbsp;&nbsp;&nbsp;branches: '*'

jobs:
&nbsp;&nbsp;build-in-container:
&nbsp;&nbsp;&nbsp;&nbsp;runs-on: ubuntu-latest

&nbsp;&nbsp;&nbsp;&nbsp;strategy:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;fail-fast: false
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;matrix:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;version:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- '5.32'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- '5.34'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- '5.30'

&nbsp;&nbsp;&nbsp;&nbsp;name: Test perl v${{ matrix.version }}
&nbsp;&nbsp;&nbsp;&nbsp;steps:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- uses: actions/checkout@v4

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- name: Regular tests with ${{ matrix.version }}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;env:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PERL_VERSION: ${{ matrix.version }}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;run: prove --exec &quot;perl -Mv$PERL_VERSION&quot; -lv t/

The version that the runner uses is 5.34; for the time being the default Ubuntu runner is all it has. And we want to use that default runner. See here? No setup necessary; we just set up the matrix, check out, and run the tests! Actually, we are kinda cheating here. Since the only perl we do have in the runner is the 5.34 version, we need to simulate the other versions via a not very well known option of `prove` that allows us to tell it which version pragma is going to precede the running of the test. Since we don't have any other version to override it, it will simply run 5.34 as if it was running the version in the matrix. This test again clocks in at 0 seconds in GitHub actions, the only fraction of the action taking up a bit more being checkout. Again, fast as fast can be as long as you can put up with testing stuff with 5.34, which is no big deal, since actions are going to run in the action runner.

Of course, you have to actually do something with this for the action to work. So you can write something like this in a file called action.src.pl:

use v5.34;
use feature 'signatures';

use lib qw(lib);

use Markdowner qw(headerOK);
use GitHub::Actions;

my @directories = split(&quot; &quot;, $ENV{'DIRS'});

start_group(&quot;Markdown headers&quot;);
for my $dir (@directories) {
&nbsp;&nbsp;my @markdownFiles = glob(&quot;$dir/*.md&quot;);
&nbsp;&nbsp;for my $mdFile (@markdownFiles) {
&nbsp;&nbsp;&nbsp;&nbsp;open my $mdfh, &quot;&lt;&quot;, $mdFile;
&nbsp;&nbsp;&nbsp;&nbsp;my $firstLine = &lt;$mdfh&gt;;
&nbsp;&nbsp;&nbsp;&nbsp;close $mdfh;
&nbsp;&nbsp;&nbsp;&nbsp;chop( $firstLine );
&nbsp;&nbsp;&nbsp;&nbsp;if ( headerOK( $firstLine ) ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;debug &quot;Â«$firstLineÂ» is proper markdown ho, ho, ho&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;} else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;error_on_file( &quot;Haar! Â«$firstLineÂ» is not proper markdown&quot;, $mdFile, 1, 1 );
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;}
}
end_group;

Which takes as input a string with whitespace-separated directories, looks up markdown files (with the extension .md), and checks if the header is OK. But before doing that, it issues a start_group command from GitHub::Actions. This is a no-dependencies CPAN module by YT that perlizes GitHub actions commands so that you don't have to worry about them; in this case, it makes all text to be enclosed in a group so that the output is not too verbose; too many messages can occlude actual errors or warnings. Because it will also print if the first line of the markdown files is OK, and Santa can be happy about his newsletters and memos being properly formatted, or maybe not, in which he will turn into a pirate and issue an error indicating the name of the file (and the line and columns, but this is not important in this case).

You can check how it goes, for instance, in this run (actually, while you're at it, you can check the whole repository here).

Still not there, however. Now what we have is a CPAN module, didn't you sell us on the motto "No setup required"? Right on, I did, which is why now you need to fatpack the whole thing into a single file action.pl. This is what we will actually pack into the action-packed action. OK, maybe that's an action too many. Anyway, we can now define the action metadata this way:

inputs:
&nbsp;&nbsp;directories:
&nbsp;&nbsp;&nbsp;&nbsp;description: 'Directories to look for files'
&nbsp;&nbsp;&nbsp;&nbsp;default: .
runs:
&nbsp;&nbsp;using: &quot;composite&quot;
&nbsp;&nbsp;steps:
&nbsp;&nbsp;&nbsp;&nbsp;- uses: actions/checkout@v4
&nbsp;&nbsp;&nbsp;&nbsp;- run: ${GITHUB_ACTION_PATH}/action.pl
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;env:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;DIRS: ${{ inputs.directories }}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;shell: bash

It checks out the repository that holds the action, but it actually needs just the single file without needing to adjust library directories or anything like that. It just works. The specific step takes around 1 second, with is 100% more than it did when it took 0 seconds, but still. Not a great deal.

With this, Santa was happy because he could set up GitHub Actions for his newsletter/letter/whatever I said above that used markdown repository. Be it in its own action or as part or another, this will be quite enough:

steps:
- name: checkout
&nbsp;&nbsp;uses: actions/checkout@v4
- name: Run over this repo
&nbsp;&nbsp;uses: repo/action-name@main
&nbsp;&nbsp;with:
&nbsp;&nbsp;&nbsp;&nbsp;directories: &quot;. docs&quot;

Haar! There was a bad file in the batch! Without failing the whole step, which wouldn't look good on the repo badges, GitHub reported "1 error" in "Annotations" for the workflow, and then

     Run over this repo: docs/this-is-bad.md#L1
     Haar! &laquo;Just bad&raquo; is not proper markdown

He called the responsible elf after running git blame on the bad file, who said of course that "Ha ha I was just testing ha. That's a mighty good workflow. Merry Christmas to you!"

Santa smiled broadly and said "That it is. Perl, my child, is love in GitHub actions" Merry Christmas everyone!

Using Valiant for Validations in Agendum: A Deep Dive into DBIx::Class Integration

2024-12-14T00:00:00Z

Agendum is a single user task-tracking application built on Perl Catalyst and DBIx::Class. I'm using it as a testbed to experiment with various new approaches to building web applications with this venerable framework as well as a platform to demo those experiments in articles and at conferences.

One concern of any web framework is data validation. Perl has no lack of validation libraries, including some that have Catalyst integrations. To this list of options I've added my own approach, Valiant which I hope has enough distinguishing features to merit your interest.

Valiant can be used in several ways, but in this article I'm going to focus on how I've integrated it with DBIx::Class in Agendum. I recognize many people prefer validation as a layer separate from the physical database model, but I've found that for many applications it's useful to have the validation declaratively defined in the model layer. This allows for a single source of truth for the validation rules, and also allows for the validation to be automatically applied when the data changed on the database. This is especially useful in a web application where the data is often roundtripped between the database and the user for editing. If this offends your sense of architectural purity, there are ways to use Valiant that are more separate from the database layer, but I'm not going to cover that in this article. You'll have to look over the documentation yourself ;). In any case this approach has worked well for many other frameworks such as Ruby on Rails, so I think it's worth considering for Perl as well.

This article will not cover all the ins and outs of Valiant but I will provide an overview of the features that are most relevant to this discussion. Hopefully this will provoke your interest enough to check out the Valiant documentation and give it a try. If you are a 'code first' kind of person, you can also just clone down Agendum, look it over and start it up with make up on any system with Docker installed.

Valiant Overview (in a nutshell)

This is a very brief overview of Valiant. For more details please see the Valiant documentation.

Valiant basically is a role that can be applied to any Perl class. It provides a declarative way to define validation rules for the class. These rules typically are applied to Moo or Moose style attributes but you can also declare model level validations when you have rules that apply to the object as a whole or to multiple attributes. The rules are defined in a simple DSL that is easy to read and write. Here's an example:

package MyApp::Model::User;

use Moo;
use Valiant::Validations;

has 'name' =&gt; (is=&gt;'ro');
has 'email' =&gt; (is=&gt;'ro');

validates 'name', presence =&gt; 1;
validates 'email', format =&gt; 'email';

This adds two validation rules to the User class. The first rule says that the name attribute must be present (i.e. not undef or an empty string). The second rule says that the email attribute must be a valid email address. Let's see how this works in practice:

my $user = MyApp::Model::User-&gt;new(name=&gt;'John', email=&gt;'not_an_email');
$user-&gt;validate;
my %errors = $user-&gt;errors-&gt;to_hash(full_messages=&gt;1);

This will return a hash:

( email =&gt; ['Email is not an email address'] )

There's a lot of different ways to define validations, to customize error messages, and to retrieve the errors. You can also define custom validators, and you can define validations that are conditional on other attributes. You can also define validations that are conditional on the object state. All this is covered in the full Valiant documentation but this gives you the basic idea.

The Demo Database Model

Here's an overview of the database model for Agendum, which we'll use as a demo for the rest of this article:

            +-----------------+                +------------------+
            |      tasks      |                |     comments     |
            +-----------------+                +------------------+
            | *task_id*       |&lt;------------+  | *comment_id*     |
            | title           |             |--| task_id (FK)     |
            | description     |                | content          |
            | due_date        |                | created_at       |
            | priority        |                +------------------+
            | status          |
            | created_at      |
            | updated_at      |
            +-----------------+
                   ^
                   |
                   |
            +-----------------+
            |   task_labels   |
            +-----------------+
            | *task_id* (FK)  |
            | *label_id* (FK) |
            +-----------------+
                   |
                   v
            +-----------------+
            |      labels     |
            +-----------------+
            | *label_id*      |
            | name (UNIQUE)   |
            +-----------------+

The database model is pretty simple:

Tasks: Stores core information for each task, including the title, description, due_date, priority, and status. This is the main entity in the application.
Labels: Contains information for categorizing tasks, such as 'Work', 'Research', or 'Planning'. Tasks can be assigned zero or more labels.
Task-Labels: A many-to-many relationship table linking tasks and labels, enabling a task to have multiple labels and a label to apply to multiple tasks.
Comments: Stores comments on tasks; basically a freeform note taking log of activity on a task. Each task can have zero or more comments.

If you want full details you can check out the actual SQL used to create the database in the Agendum repository https://github.com/jjn1056/Agendum/blob/main/sql/deploy/initial.sql.

The Validations

Here's the validation rules for the Task class in Agendum:

Task Title: The task title must be present and between 2 and 48 characters.
Task Description: The task description must be present and between 2 and 2000 characters.
Task Due Date: The task due date must be present and a valid date that is greater than or equal to the current date. This validation is only enforced when the due date is created or actually changed in an update.
Task Priority: The task priority must be present and be a number between 1 and 5
Task Status: The task status must be present and be one of 'pending', 'in_progress', 'on_hold', 'blocked', 'canceled', or 'completed'. A task cannot return to 'Pending' once it's begun. In addition, once a task is set to completed it cannot be changed to any other status. Lastly a task that is 'on hold' or 'blocked' can't be set to completed directly.

And the rules for the Comment class:

Content: The content must be present and between 2 and 2000 characters.

There's an element of arbitrariness to these rules, but I wanted something complex enough to be interesting but not so complex that it would be overwhelming. Feel free to tinker as you wish.

Valiant and DBIx::Class

So how do we integrate Valiant with DBIx::Class? There are two DBIx::Class components that you need to add to your result sources and your resultsets, which integrate Valiant with DBIx::Class and additionally provide extra features to make it work more like how you'd expect it. We also provide some value added features to DBIx::Class to make it easier to work with Valiant in the context of a web application, such as full recursive update and create. You can check out the core documentation at your leisure (DBIx::Class::Valiant, DBIx::Class::Valiant::Result, DBIx::Class::Valiant::ResultSet) , but I'll provide a brief overview here using code from Agendum. First here's the Schema class (if you are not super familiar with DBIx::Class you might want to check out the DBIx::Class documentation before continuing):

package Agendum::Schema;

use base 'DBIx::Class::Schema';
use Agendum::Syntax;

__PACKAGE__-&gt;load_components(qw/
  Helper::Schema::QuoteNames
  Helper::Schema::DidYouMean
  Helper::Schema::DateTime/);

__PACKAGE__-&gt;load_namespaces(
&nbsp;&nbsp;default_resultset_class =&gt; &quot;DefaultRS&quot;);

There's nothing here directly related to Valiant but I wanted to show you the schema class for completeness. Here's the base result class:

package Agendum::Schema::Result;

use base 'DBIx::Class';
use Agendum::Syntax;

__PACKAGE__-&gt;load_components(qw/
  Valiant::Result
  Valiant::Result::HTML::FormFields
  ResultClass::TrackColumns
  Core
  InflateColumn::DateTime
/);

Here you can see I'm installing the core DBIx::Class::Valiant::Result component, as well as some other components that are useful for web applications. The Valiant::Result::HTML::FormFields component is useful for generating form fields in a web application, and the ResultClass::TrackColumns component is useful for tracking changes to the database model. You will see later that we need that to make the status validations work.

The InflateColumn::DateTime component is useful for working with DateTime objects in the database model.

One thing to keep in mind is that Valiant::Result needs to be the first component in the list. I'm working on figuring out if this can be relaxed, but for now it's a requirement.

Here's the base resultset class:

package Agendum::Schema::ResultSet;

use base 'DBIx::Class::ResultSet';
use Agendum::Syntax;

__PACKAGE__-&gt;load_components(qw/
  Valiant::ResultSet
  Helper::ResultSet::Shortcut
  Helper::ResultSet::Me
  Helper::ResultSet::SetOperations
  Helper::ResultSet::IgnoreWantarray
/);

Again I'm installing the core DBIx::Class::Valiant::ResultSet component, as well as some other components that are useful for web applications. Our component again is first in the list.

Lastly here's the default resultset class, which was mentioned in the Schema class. This is the resultset DBIC uses when you don't have a custom one for a given result source:

package Agendum::Schema::DefaultRS;

use base 'Agendum::Schema::ResultSet';
use Agendum::Syntax;

As you can see there is not much going on here. I know a lot of people set the default resultset class to the base resultset but I'd rather separate them out. It's a personal preference.

Ok, so far there is nothing really interesting. The real magic happens in the result classes. Let's do the Task result class. I will introduce the code in sections with explanations but you can always see the full code in the Agendum repository.

package Agendum::Schema::Result::Task;

use Agendum::Syntax;
use base 'Agendum::Schema::Result';

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

__PACKAGE__-&gt;add_columns(
&nbsp;&nbsp;task_id =&gt; { data_type =&gt; 'integer', is_nullable =&gt; 0, is_auto_increment =&gt; 1 },
&nbsp;&nbsp;title =&gt; { data_type =&gt; 'varchar', is_nullable =&gt; 0, size =&gt; 255 },
&nbsp;&nbsp;description =&gt; { data_type =&gt; 'text', is_nullable =&gt; 1 },
&nbsp;&nbsp;due_date =&gt; { data_type =&gt; 'date', is_nullable =&gt; 1 },
&nbsp;&nbsp;priority =&gt; { data_type =&gt; 'integer', is_nullable =&gt; 1, default_value =&gt; 1 },
&nbsp;&nbsp;status =&gt; { data_type =&gt; 'varchar', is_nullable =&gt; 1, size =&gt; 50, default_value =&gt; 'pending', track_storage =&gt; 1 },
&nbsp;&nbsp;created_at =&gt; { data_type =&gt; 'timestamptz', is_nullable =&gt; 1, default_value =&gt; \'NOW()' },
&nbsp;&nbsp;updated_at =&gt; { data_type =&gt; 'timestamptz', is_nullable =&gt; 1, default_value =&gt; \'NOW()' },
);

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

__PACKAGE__-&gt;has_many(
&nbsp;&nbsp;comments =&gt;
&nbsp;&nbsp;'Agendum::Schema::Result::Comment',
&nbsp;&nbsp;{ 'foreign.task_id' =&gt; 'self.task_id' }
);

__PACKAGE__-&gt;has_many(
&nbsp;&nbsp;task_labels =&gt; 'Agendum::Schema::Result::TaskLabel',
&nbsp;&nbsp;{ 'foreign.task_id' =&gt; 'self.task_id' }
);

This first part is just the standard DBIx::Class stuff. We define the table, the columns, the primary key, and the relationships. BTW you can use DBIx::Class::Candy with this if you like, Valiant integrations support that and you can read about it in the docs. However you might have noticed the track_storage flag on the status field. We need that for the status validations since we will be comparing the state in the database to the new proposed value. It's provided by the DBIx::ClassResultClass::TrackColumns component.

The next part is where we start adding the Valiant stuff:

__PACKAGE__-&gt;accept_nested_for('task_labels', {allow_destroy=&gt;1});
__PACKAGE__-&gt;accept_nested_for('comments', {allow_destroy=&gt;1});

Since DBIx::Class::Valiant::Result adds support for nested updates and creates (and optionally deletes) we need to tell the result class which relationships we want to support this for. In this case we want to support nested updates and creates for the task_labels and comments relationships. This is useful for web applications where you might want to update a task and its labels and comments all in one go. I force you to specify this support as a security feature. The next bit defines the validations:

__PACKAGE__-&gt;validates(title =&gt; (presence=&gt;1, length=&gt;[2,48]));
__PACKAGE__-&gt;validates(description =&gt; (presence=&gt;1, length=&gt;[2,2000]));

__PACKAGE__-&gt;validates(priority =&gt; (presence=&gt;1));
__PACKAGE__-&gt;validates(status =&gt; (presence=&gt;1));

Basic validations for required fields and minimum and maximum lengths. The next bit is a bit more complex:

__PACKAGE__-&gt;validates(status =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;presence =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;inclusion =&gt; \&amp;status_list,
&nbsp;&nbsp;&nbsp;&nbsp;with =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;method =&gt; 'valid_status',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;on =&gt; 'update',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if =&gt; 'is_column_changed', # This method defined by DBIx::Class::Row
&nbsp;&nbsp;&nbsp;&nbsp;},
&nbsp;&nbsp;)
);

Status is an enum field, so we use the inclusion validator to ensure the value is in the list of valid status values. You have a few ways to describe the list of valid values, but in this case I'm using a method:

sub status_list {
&nbsp;&nbsp;my ($self) = shift;
&nbsp;&nbsp;return qw(pending in_progress on_hold blocked canceled completed);
}

This can be useful if the allowed list changes based on things like the user or the state of the object.

I also specify that this validation only runs on update (not create) and only if the status field is changed. This is to prevent running the validation when the object is first created, since we won't have any 'old' values for the comparison. Additionally we only want to run this validation if the status field is changed since some of the validation logic depends on 'old state versus new state'. This is a common pattern in web applications where the user submits the entire form and then you have to distinguish on the server side between fields that have changes and those that don't. For many validations such as 'presence' running the validation for each request has no downside other than additional overhead, but for the status field the rules are complex enough that we want to be more selective.

I also define a custom validator for the status field via a method which is called when the status is updated and changed. Here's that method:

sub valid_status($self, $attribute_name, $value, $opt) {
&nbsp;&nbsp;my $old = $self-&gt;get_column_storage($attribute_name);

&nbsp;&nbsp;# If the task is not pending, it can't return to pending (ie once a task is
&nbsp;&nbsp;# started it can't be unstarted)
&nbsp;&nbsp;if($value eq 'pending' &amp;&amp; $old ne 'pending') {
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;errors-&gt;add($attribute_name, &quot;can't return to pending&quot;, $opt);
&nbsp;&nbsp;}

&nbsp;&nbsp;# If the task is completed, it can't change to any other status (ie once a task is
&nbsp;&nbsp;# finished it can't be unfinished)
&nbsp;&nbsp;if($old eq 'completed' &amp;&amp; $value ne 'completed') {
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;errors-&gt;add($attribute_name, &quot;task is already finished&quot;, $opt);
&nbsp;&nbsp;}

&nbsp;&nbsp;# If the task is on hold or blocked, it can't be moved to completed.  You need to
&nbsp;&nbsp;# unhold or unblock it first.
&nbsp;&nbsp;if ($old eq 'on_hold' &amp;&amp; $value eq 'completed') {
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;errors-&gt;add($attribute_name, &quot;on hold can't change to completed&quot;, $opt);
&nbsp;&nbsp;}
&nbsp;&nbsp;if ($old eq 'blocked' &amp;&amp; $value eq 'completed') {
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;errors-&gt;add($attribute_name, &quot;blocked can't change to completed&quot;, $opt);
&nbsp;&nbsp;}
}

So in this method we enforce the more complex state transition rules for the status field.

So when using Valiant you have a lot of options for describing validation rules. These can be as complex or simple as you need. For the simple stuff we try to stick with the built in validators so we can be declarative about the rules but when you need power Valiant makes it easy to drop into an arbitrarily complex method.

The last bit is the due date validation:

__PACKAGE__-&gt;validates(due_date =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;presence =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;date =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;min_eq =&gt; sub { pop-&gt;today },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if =&gt; 'is_column_changed',
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;)
);

Here we use the date validator to ensure the value is a valid date, and then we use the min_eq option to ensure the date is greater than or equal to the current date. We only enforce this validation if the due date is changed. Otherwise we'd get validation errors whenever a task was late and the user tried to change a different field such as descriptions, or adding a comment.

Finally the Comment result class has a validation. It's not much so I will just show all the code:

package Agendum::Schema::Result::Comment;

use Agendum::Syntax;
use base 'Agendum::Schema::Result';

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

__PACKAGE__-&gt;add_columns(
&nbsp;&nbsp;comment_id =&gt; { data_type =&gt; 'integer', is_nullable =&gt; 0, is_auto_increment =&gt; 1 },
&nbsp;&nbsp;task_id =&gt; { data_type =&gt; 'integer', is_nullable =&gt; 0 },
&nbsp;&nbsp;content =&gt; { data_type =&gt; 'text', is_nullable =&gt; 0 },
&nbsp;&nbsp;created_at =&gt; { data_type =&gt; 'timestamptz', is_nullable =&gt; 1, retrieve_on_insert =&gt; 1, default_value =&gt; \'NOW()' },
);

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

__PACKAGE__-&gt;belongs_to(
&nbsp;&nbsp;task =&gt;
&nbsp;&nbsp;'Agendum::Schema::Result::Task',
&nbsp;&nbsp;{ 'foreign.task_id' =&gt; 'self.task_id' }
);

# Here's the validation rule
__PACKAGE__-&gt;validates(content =&gt; (presence=&gt;1, length=&gt;[2,2000]));

So the content field is required and must be between 2 and 2000 characters.

Using the Validations

In Agendum, these validations are run from the Catalyst controllers which gather field info from a POST request. However if you are just writing a test script you can run the validations directly on the object. Here's an example (it's from t/advent.t in the Agendum repository):

use Test::Most;
use Test::DBIx::Class -schema_class =&gt; 'Agendum::Schema';

ok my $task = Schema-&gt;resultset('Task')-&gt;create({
&nbsp;&nbsp;&nbsp;&nbsp;title =&gt; 'A Task',
&nbsp;&nbsp;&nbsp;&nbsp;description =&gt; 'A description',
&nbsp;&nbsp;&nbsp;&nbsp;due_date =&gt; '2000-12-31',
&nbsp;&nbsp;&nbsp;&nbsp;priority =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;status =&gt; 'pending',
&nbsp;&nbsp;&nbsp;&nbsp;comments =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ content =&gt; 'A comment' },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ content =&gt; 'A' }, # This comment is too short
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;task_labels =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ label =&gt; { name =&gt; 'not_a_label' } },
&nbsp;&nbsp;&nbsp;&nbsp;],
});

use Devel::Dwarn;
Dwarn +{ $task-&gt;errors-&gt;to_hash(full_messages=&gt;1) };

This would output something like:

+{
&nbsp;&nbsp;comments =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Comments Are Invalid&quot;,
&nbsp;&nbsp;],
&nbsp;&nbsp;&quot;comments[1].content&quot; =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Comments Content is too short (minimum is 2 characters)&quot;,
&nbsp;&nbsp;],
&nbsp;&nbsp;task_labels =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Task Labels Are Invalid&quot;,
&nbsp;&nbsp;],
&nbsp;&nbsp;&quot;task_labels[0].label&quot; =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Task Labels Label Related Model 'Label' Not Found&quot;,
&nbsp;&nbsp;],
};

You might notice I didn't need to call validate on the object. That's because the create method calls validate for you. Same thing for update. If you prefer more control you can disable this behavior, but I find it useful for web applications. The database modification will be canceled if validations fail. However the DBIC result object will maintain the changed state, which makes it useful as a place to hold request information for use in a web template or HTML form. In fact the Valiant distribution includes a component that can generate form fields for you based on the the model (Valiant::HTML::FormBuilder) but covering that is beyond the scope of this article.

Conclusion

I hope this article has given you a basic overview of how to use Valiant with DBIx::Class. I skipped on a few of the more advanced features, such as custom validators, delegating validation to other objects, internationalization, filtering, using the form builder and more. If you want to get a feel for some of those things you can play with the Agendum application and read more about them in the full Valiant documentation.

I'm always looking for feedback on Valiant and the DBIx::Class integration. If you have any thoughts or suggestions please feel free to reach out to me via email or on the Valiant github repository. I'm also happy to take pull requests if you have a feature you'd like to add. For example, it's very easy to add more built in validators, or enhance existing ones. I hope you find Valiant useful and I look forward to seeing what you build with it. If you are interested in how to use this to build web applications with Catalyst I hope you'll check out the Agendum repository and keep an eye out for future articles and talks, including one pending later this December 2024.

Production monitoring

2024-12-13T00:00:00Z

Meeting the Quota

Santa has a big problem. The world's population is growing, and there are over 2 billion children alive today. Long ago, he had already turned his cute little shop into a big production facility. The elves have been trained to run highly sophisticated production lines 24/7 all year round.

But it's a huge task. Literally every second counts. While Santa guards the exact numbers very closely (especially his naughty/nice list), we can make some estimates:

Most children fall under the nice category. Since Santa wouldn't know the final result until he starts his delivery run, let's assume that he has to produce presents for everyone. Make that 2 billion children from ages zero to fourteen.
Each child gets, on average, 2 presents
The elves work every day, even when Santa is out for delivery.

That gives us 365 days (leap years are quite relaxed, they give a whole extra day!). That gives the elves 525.600 minutes to work with.

To reach the required 4 billion presents, the elves have to produce on average 7610,35 presents per minute. If any production line falls behind, the others have to pick up the pace, or children will have a bad christmas experience.

Monitoring

The elves already implemented monthly, weekly and even daily reports in their warehouse management systems. But now they want production numbers every minute in order to be able to react more quickly to any problems.

While they can run the other reports from their warehouse management system, getting the minute-by-minute data in real time proved a bit more tricky. So Santa decided to do some Perl coding to solve that problem. The production lines already use Perl in their control systems, so reporting the numbers should be easy to add to the codebase.

After some googling, he found an article on PerlMonks about a module called Net::Clacks that could do (more-or-less) real-time communication between programs. So he decided to give it a try.

Server Configuration

Since this is a network application, it needs to be secured. A self-signed certificate will do nicely for testing (but Santa also set a reminder to learn about that LetsEncrypt thing after the Christmas season). For now, he just copied&pasted some awfully weird openssl command line to get the job done:

    yes &#39;&#39; | openssl req -new -newkey rsa:4096 -x509 -sha256 -days 36500 -nodes -out exampleserver.crt -keyout exampleserver.key

To set up the server itself, Santa also created a simple XML configuration file (server.xml). For testing, Santa uses 127.0.0.1 to run tests, but will change that to the correct IP later (the exact network setup in Santas factory is proprietary information, though).

&lt;clacks&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;appname&gt;Clacks Master&lt;/appname&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;ip&gt;127.0.0.1&lt;/ip&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;port&gt;49888&lt;/port&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;pingtimeout&gt;600&lt;/pingtimeout&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;interclackspingtimeout&gt;60&lt;/interclackspingtimeout&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;persistancefile&gt;clackspersistance.dat&lt;/persistancefile&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;ssl&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;cert&gt;exampleserver.crt&lt;/cert&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;key&gt;exampleserver.key&lt;/key&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/ssl&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;!-- This is the main user that has all permissions and also Interclacks --&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;username&gt;santa&lt;/username&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;password&gt;WorkSmarterNotHarder&lt;/password&gt;

&nbsp;&nbsp;&nbsp;&nbsp;&lt;throttle&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;maxsleep&gt;5000&lt;/maxsleep&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;step&gt;1&lt;/step&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/throttle&gt;
&lt;/clacks&gt;

Server

The server code itself is as simple as it gets. All he needs to do is load Net::Clacks::Server and call its run method.

But to make sure he can easily test local changes to Net::Clacks without having to "make install" it every time, he also added a bit of boilerplate code to support the --debug command line flag:

#!/usr/bin/env perl

use v5.40;
use strict;
use warnings;
use diagnostics;
use utf8;
use Carp;

my $isDebugging = 0;

BEGIN {
&nbsp;&nbsp;&nbsp;&nbsp;if(defined($ARGV[1]) &amp;&amp; $ARGV[1] eq &quot;--debug&quot;) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print(&quot;Development INC activated\n\n&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;unshift @INC, &quot;/home/santa/src/Net-Clacks/lib&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$isDebugging = 1;
&nbsp;&nbsp;&nbsp;&nbsp;}
};

use Net::Clacks::Server;

my $configfile = shift @ARGV;
croak(&quot;No Config file parameter&quot;) if(!defined($configfile) || $configfile eq '');

my $worker = Net::Clacks::Server-&gt;new($isDebugging, $configfile);
$worker-&gt;run;

Running the Server

Now Santa can simply run the server with:

    perl server.pl server.xml

Design Decisions

There are multiple ways to track events in Net::Clacks. One way would be that every time a present is produced, the machines NOTIFY the LISTENer. But that would mean the listener would receive 1000's of messages per minute and count them.

But there's a smarter way. Santa can just have the Net::Clacks server do all the counting by sending it INCREMENT command for a variable name. The variable will get autovivified on first use.

To read the numbers minute-by-minute, Santa can just read the variable at the top of every minute. Of course, he can't just set the variable back to zero, as he would be in a race condition with the increment commands from the production lines. Fortunately, while the increment and decrement commands default to "1", they have an optional argument to use any arbitrary number.

By reading out the current variable value, then sending this value as the decrement amount, Santa can avoid the race condition entirely. Well, technically, the value on the server side might not reach zero internally, but that doesn't matter, the minute-by-minute numbers as seen from the client side will still be correct. Dealing with asynchronous events give Santa a headache.

Central Client

Clients need a lot less configuration than the server, so Santa doesn't need a special configuration file. For now, he can just hardcode the login information.

The first thing he does is code up the monitoring client (monitor.pl):

#!/usr/bin/env perl

use v5.40;
use strict;
use warnings;
use diagnostics;
use mro 'c3';
use Carp;

use Net::Clacks::Client;
use Time::HiRes qw(sleep);

my $username = 'santa';
my $password = 'WorkSmarterNotHarder';
my $applicationname = 'monitoring';
my $is_caching = 0;
my $countername = 'FactoryOutput';

my $client = Net::Clacks::Client-&gt;new('127.0.0.1', 49888, $username, $password, $applicationname, $is_caching);

$client-&gt;ping(); # We need to regularly send a ping() to the server to avoid disconnects
$client-&gt;doNetwork(); # Do the actual network part, most commands just get buffered in a queue

my $nextping = time + 60;
my $timestamp = ''; # When program starts, report the current count (if any) immediately

while(1) {
&nbsp;&nbsp;&nbsp;&nbsp;if($nextping &lt; time) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$client-&gt;ping();
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$nextping = time + 60;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;$client-&gt;doNetwork();
&nbsp;&nbsp;&nbsp;&nbsp;while((my $msg = $client-&gt;getNext())) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if($msg-&gt;{type} eq 'disconnect') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print '+++ Disconnected by server, reason given: ', $msg-&gt;{data}, &quot;\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;last;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;my $newtime = getMinuteTimestamp();
&nbsp;&nbsp;&nbsp;&nbsp;if($newtime ne $timestamp) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# Time changed
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$timestamp = $newtime;

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $produced = $client-&gt;retrieve($countername);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if(!defined($produced)) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$produced = 0; # Only happens on initial startup when the clacks variable is not initialized
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Initial startup!\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$client-&gt;decrement($countername, $produced); # Decrement the count by the number we just received
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$client-&gt;doNetwork();

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print $produced, &quot;\t&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if($produced &lt; 7610) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print &quot;ALERT!!!! PRODUCTION SHORTFALL!!!!!\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print &quot;OK!\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;sleep(0.1); # Let's run the loop 10 times a second, this should get us very close to the top of every minute without wasting too much CPU cycles
}
$client-&gt;disconnect();
exit(0);

sub getMinuteTimestamp {
&nbsp;&nbsp;&nbsp;&nbsp;# Quick-and-dirty hack, only changes at the start of every minute
&nbsp;&nbsp;&nbsp;&nbsp;my ($sec,$min, $hour, $mday,$mon, $year, $wday,$yday, $isdst) = localtime time;

&nbsp;&nbsp;&nbsp;&nbsp;return join(':', $year, $mon, $mday, $hour, $min);
}

Incrementing the Counter

For incrementing the counter, Santa created the creatively named, object-oriented package "OutputCounter". This can then be easily used in existing perl programs.

Before creating a proper distribution on his local CPAN ("DarkPAN") mirror, he just put this and a test program into a single file (factorymachine.pl):

#!/usr/bin/env perl

package OutputCounter;

use v5.40;
use strict;
use diagnostics;
use mro 'c3';
use Carp;

use Net::Clacks::Client;

sub new($proto, %config) {
&nbsp;&nbsp;&nbsp;&nbsp;my $class = ref($proto) || $proto;
&nbsp;&nbsp;&nbsp;&nbsp;my $self = bless \%config, $class;

&nbsp;&nbsp;&nbsp;&nbsp;my %defaults = (
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ip =&gt; '127.0.0.1',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;port =&gt; 49888,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;username =&gt; 'santa',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;password =&gt; 'WorkSmarterNotHarder',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;applicationname =&gt; 'NonbrandStackablePlasticBlocks',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;is_caching =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;countername =&gt; 'FactoryOutput',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;nextping =&gt; time + 60,
&nbsp;&nbsp;&nbsp;&nbsp;);

&nbsp;&nbsp;&nbsp;&nbsp;foreach my $key (keys %defaults) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if(!defined($self-&gt;{$key})) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# Use the default
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{$key} = $defaults{$key};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_createClient();

&nbsp;&nbsp;&nbsp;&nbsp;return $self;
}


sub _createClient($self) {
&nbsp;&nbsp;&nbsp;&nbsp;my $client = Net::Clacks::Client-&gt;new($self-&gt;{ip}, $self-&gt;{port}, $self-&gt;{username}, $self-&gt;{password}, $self-&gt;{applicationname}, $self-&gt;{is_caching});

&nbsp;&nbsp;&nbsp;&nbsp;$client-&gt;ping(); # We need to regularly send a ping() to the server to avoid disconnects
&nbsp;&nbsp;&nbsp;&nbsp;$client-&gt;doNetwork(); # Do the actual network part, most commands just get buffered in a queue

&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{client} = $client;

&nbsp;&nbsp;&nbsp;&nbsp;return;
}

sub increment($self) {


&nbsp;&nbsp;&nbsp;&nbsp;if($self-&gt;{nextping} &lt; time) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{client}-&gt;ping();
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{nextping} = time + 60;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{client}-&gt;doNetwork();

&nbsp;&nbsp;&nbsp;&nbsp;while((my $msg = $self-&gt;{client}-&gt;getNext())) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if($msg-&gt;{type} eq 'disconnect') {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# Got a disconnect. Throw away current connection and create a new one
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Connection error\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_createClient();
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;last;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{client}-&gt;increment($self-&gt;{countername});
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;{client}-&gt;doNetwork();
}

package main;

use v5.40;
use strict;
use diagnostics;
use mro 'c3';
use Carp;

use Time::HiRes qw(sleep);
#use OutputCounter;

my $counter = OutputCounter-&gt;new(applicationname =&gt; 'CandyCaneMaker');

while(1) {
&nbsp;&nbsp;&nbsp;&nbsp;$counter-&gt;increment();
&nbsp;&nbsp;&nbsp;&nbsp;sleep(0.05); # Increment ~20 times a second
}

Final Thoughts

This is a minimal example of what Net::Clacks can do. Yes, it takes quite a bit of boilerplate code to get up and running, but that's true for a lot of network code. Net::Clacks is more designed for speed and reliability (including WHEN to spend those precious CPU cycles), than it is for simple coding. But, generally, the tradeoff can be a significant benefit. The author of Net::Clacks uses it in many commercial, production critical systems.

Stay focused and organised during the advent season

2024-12-12T00:00:00Z

Toys warehouse and drones

Christmas is approaching and the elves are getting excited and stressed preparing all the packages. In 2024, North Pole is equipped with a Toy Warehouse that replaced the ancient Toy Workshop. Toys are now ordered to a network of third party elves workshops.

In the recent years, Santa simplified his deliveries by investing in a Reindeer Drones Delivery system, also known as RDD. It makes the work much easier and reduced deliveries errors: did you ever wonder why some persons were unhappy with their christmas present?

Toy Factory, by Steven Miller - CC BY 2.0 license

North Pole elves use top notch automation and deliveries dispatch systems, but still, this is a very critical time with a non-negotiable deadline. The stress is at its peak. All sort of operational issues must be managed, what requires to communicate efficiently with the DEBT (Devops Elves Backend Team).

Agile at the Toys warehouse

Santa's elves teams do daily standups. This is what Elf Product Owner decided after it looked like it would improve the overall North Pole teams' mental health. Each elf have to speak up and announce:

what they did in the last day
what they plan to do today
announce any blocker so that other elves can support them

It proved to encourage team communication and Elf Product Owner is able to inform other teams about any blockers that could put this sensitive work at risk.

Someone is getting extra-stressed

Now Hermey the Elf got more problems... Since Hermey was not too interested in toys making and that he seemed to have an interest in meticulous work, Elf Product Owner decided to realocate him to the RDD team led by Elf Sparkle. Getting stressed about the long December month was already quite a burden. But speakink every morning in front of other elves about what he accomplished, tell his feelings, and asking for help is definitely too much for Hermey. The poor thing couldn't bear it and each day, he would babble a meaningless report. The stress of the social meeting makes it harder for Hermey because he is not the kind of person able to improvise a thirty-seconds talk.

App::Standup::Diary to the rescue

Sparkle, the team manager, noticed Hermey's struggle. She decided to share a tool she developed and used since a couple of years. "Take a look at App::Standup::Diary on the CPAN", she said. "It might help you organising your thoughts and communicate better.". Hermey nodded and went to his terminal:

    cpm install -g App::Standup::Diary

"Check the chat, I have sent you a nice bash alias" Sparkle said:

    alias diary=&quot;diary --data-dir ~/toy-warehouse/standup --project-name &#39;rdd&#39;&quot;

Once you will have configured that, we'll take a dive into the internals together!

Daily usage

--data-dir is where the stand-up notes are automatically stored and sorted by year and month. One file per day. --project-name is used for each note file name, as well as the file title. The directory tree looks like this:

tree /home/sparkle/toy-warehouse/standup
/home/sparkle/toy-warehouse/standup
&#x251C;&#x2500;&#x2500; 2021
&#x251C;&#x2500;&#x2500; 2022
&#x251C;&#x2500;&#x2500; 2023
&#x2514;&#x2500;&#x2500; 2024
&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 01
&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 02
&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 03
&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; etc.
&nbsp;&nbsp;&nbsp;&nbsp;&#x2514;&#x2500;&#x2500; 11
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 2024-11-04_rdd.md
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 2024-11-05_rdd.md
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 2024-11-06_rdd.md
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; etc.
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 2024-11-28_rdd.md
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x251C;&#x2500;&#x2500; 2024-11-29_rdd.md
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#x2514;&#x2500;&#x2500; 2024-11-30_rdd.md

This is all what you need to know to use it as your daily stand-up notes app. Just run diary every morning and get prepared for the next meeting. Maybe you want to know more about how it works, though?

A dive into App::Standup::Diary

Let's inspect what kind of marvels this command line tool contains. It use the following CPAN modules:

Object::Pad: It's used as a base OO toolkit for classes and roles. More on that later.
Time::Piece: Dates management.
Mojo::Template: Reusable boilerplate to generate stand-up Markdown files.
Path::Tiny: Directories and files path management.

The diary command-line tool retrieve the user arguments, create the diary file object and write it on disk.

GetOptions (
&nbsp;&nbsp;&quot;data-dir:s&quot;      =&gt; \$data_dir,
&nbsp;&nbsp;&quot;project-name:s&quot;  =&gt; \$project_name
) or die(&quot;Error in command line arguments\n&quot; );

my $diary = App::Standup::Diary
&nbsp;&nbsp;-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;data_dir     =&gt; $data_dir,
&nbsp;&nbsp;&nbsp;&nbsp;project_name =&gt; $project_name
&nbsp;&nbsp;);

$diary-&gt;write;

The main App::Standup::Diary file compose two roles (with the :does() keyword) for dealing with the dates and project parts. Each role manage it's own set of fields, e.g. App::Standup::Role::Date provide the daily $date as a Time::Piece object so that it can be reused all over the place. The App::Standup::Diary::Template class generates Markdown files:

# &lt;%= $project_name %&gt; &lt;%= $today %&gt;

- done
- todo
- blocking

It doesn't allow customisation at the moment but we would really like to add a --template option so that the elves can provide a file type of their choice, or seasonnal ornaments for those who like ASCII art or emoji.

Usage of Object::Pad

App::Standup::Diary have been written with Object::Pad from scratch. It has not been converted from another OO toolkit, e.g. Moose. Its main class is equipped with the following fields:

$daily_data_path
$data_dir
$template

In addition two more field are provided by the App::Standup::Role::Date and App::Standup::Role::Project roles:

$date
$project_name

It makes very easy to declare all the class fields at the top of the class. Various field attributes are available to manipulate each fields capacites:

field $daily_data_path :accessor;
field $data_dir        :param :reader;
field $template        :accessor :writer;

Note that field replaced the has keyword for attribute declaration in usual OO Perl toolkits. It's still possible to create non-class variables with e.g. my $santa, though, no worries. Now, let's take a look at the main method:

method write {

&nbsp;&nbsp;$self-&gt;set_template( Standup::Diary::Template-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;date         =&gt; $self-&gt;date,
&nbsp;&nbsp;&nbsp;&nbsp;project_name =&gt; $self-&gt;project_name
&nbsp;&nbsp;));

&nbsp;&nbsp;if ( $self-&gt;should_create_dir ) {
&nbsp;&nbsp;&nbsp;&nbsp;say &quot;$daily_data_path should be created&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;create_directories_tree;
&nbsp;&nbsp;} else {
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;init_daily_data_path($self-&gt;build_path($self-&gt;date-&gt;ymd('/')));
&nbsp;&nbsp;}

&nbsp;&nbsp;my $file_path = path($self-&gt;build_full_file_path);

&nbsp;&nbsp;path($file_path)-&gt;spew_utf8($template-&gt;render) and say &quot;Diary entry created $file_path&quot;
&nbsp;&nbsp;&nbsp;&nbsp;unless $file_path-&gt;exists and say &quot;Entry already exist&quot;;

}

The first benefit is that we have automatic method signature (if using Perl 5.26+), and that $self is provided without having to declare it. All class fields are available through $self, including the ones that comes from roles. Since $template got a :writer attribute, we got a set_template method to mutate it's value.

After testing the diary software for a couple of years, Sparkle consider writing new code for the Reindeer Drone Delivery core software with Object::Pad (or more likely it's core implementation) instead of the aging OO toolkits, as it prove to allow the writing of clearer code, with good separation of concerns and easily testable.

use Test2::V0;
use Time::Piece;
use App::Standup::Diary;

my $d = App::Standup::Diary-&gt;new( data_dir =&gt; 'north-pole-warehouse', project_name =&gt; 'rdd' );
isa_ok $d-&gt;date, 'Time::Piece';

$d-&gt;write;
ok -e $d-&gt;daily_data_path, 'The file have been created on disk';

my $today = localtime;
my ($year_month) = $today-&gt;ymd('/') =~ m/ \d{4} \/ \d{2} /gx;

is $d-&gt;daily_data_path, $d-&gt;data_dir . '/' . $year_month, 'Daily data path match today\'s date';

done_testing();

Happy advent season!

In the end Hermey finally got permission from Elf Product Owner to open a dentist's office at the North Pole, with having him scheduled for an immediate appointment after noticing something bad with his teeth. Sparkle improved the tool with the rest of the team, what made them more productive and relaxed.

Acknowledgments

The Santa's Helpers' Helpers article by D Ruth Holloway from the 11th day of the 2023 Advent Calendar was an inspiration to write this one.

Have fun with Map::Tube

2024-12-11T00:00:00Z

"Swiss Cottage Underground Station (Jubilee Line)" by hugh llewelyn is licensed under CC BY-SA 2.0 .

Map::Tube is one of my earliest submissions to CPAN and it's a project that's very close to my heart. Over the years, I've had the joy of writing about it and I've spoken about it at many conferences. I consider it my baby though I share it with many amazing contributors who have helped make it sleeker and more powerful. Each day, I'm thankful for the contributions of those who've made this project better. Many thanks also to everyone who has used used the library to build maps for cities around the world. As of today, there are 43 maps created by 12 contributors.

Inspiration behind the map

Our first window to open is about inspiration! The journey began with the idea to create a map for the London Tube, the famous underground rail network. The first map created was Map::Tube::London. As work on Map::Tube::London progressed, I realized there was an opportunity to build a framework so others could create map for their own cities. And so, Map::Tube was born. So now you know where the term Tube came from!

The first day's play: Let's get started

It's time to open the first window and dive in! To get started, you'll need to install the framework and at least one map. For today, let's stick with the London Tube.

$ cpanm -v Map::Tube

$ cpanm -v Map::Tube::London

Now it's time to get your hands dirty!

use v5.40;
use Map::Tube::London;

my $map = Map::Tube::London-&gt;new;
say $map-&gt;get_shortest_route('Baker Street', 'Wembley Park');

Opening the window to the route finder, you should see something like this:

Baker Street (Bakerloo, Circle, Hammersmith &amp; City, Jubilee, Metropolitan), Finchley Road (Jubilee, Metropolitan), Wembley Park (Jubilee, Metropolitan)

Nice and easy, right?

If you're feeling a bit lazy and don't want to write the 4 lines perl, no worries, there's a shortcut! The Map::Tube::CLI distribution comes with a command line utility called map-tube.

Let's repeat today's fun with just one line using the command line tool: map-tube.

$ cpanm -v Map::Tube::CLI

$ map-tube --map London --start &#39;Baker Street&#39; --end &#39;Wembley Park&#39;
Baker Street (Bakerloo, Circle, Hammersmith &amp; City, Jubilee, Metropolitan), Finchley Road (Jubilee, Metropolitan), Wembley Park (Jubilee, Metropolitan)

So what's inside the map? Peek behind the curtain

Curious about how it all works? Open the next window to peek inside! There's a package called Map::Tube::Cookbook, which is part of the Map::Tube distribution that explains everything that you need to know to create a new map.

I remember the first time I gave a presentation about Map::Tube at London Perl Workshop 2017. During the talk, I challenged the audience to create a map by the end of the workshop and win a prize. To my delight, we had Map::Tube::Athens by Errietta Kostala.

Can I create a map image? Yes you can!

Opening the next window, you'll find the answer: Yes, you can generate a map images in png format. Use the map-tube command line tool to make it happen:

$ cpanm -v Map::Tube::Plugin::Graph
$ map-tube --map London --generate_map

Or if you only want a particular line, like the Bakerloo Line, here's how you do it.

$ map-tube --map London --line Bakerloo --generate_map

This will create a file in your current directory called Bakerloo.png.

Build your own map server

Opening the next window reveals the magic behind creating a map server. With the help of Map::Tube::Server, setting up a map server is easy. Here's how to create your server with map-server.psgi:

use v5.40;
use Map::Tube::Server;
use Plack::Builder;

builder { mount &#39;/map-tube/v1&#39; =&gt; Map::Tube::Server-&gt;to_app; };

Once you've set it up, start your map server like this:

$ plackup map-server.psgi
HTTP::Server::PSGI: Accepting connections at http://0:5000/

Let's make a call to the map server to repeat today's search i.e. finding the route from Baker Street to Wembley Park.

$ curl http://127.0.0.1:5000/map-tube/v1/shortest-route/london/baker%20street/wembley%20park
[&quot;Baker Street (Bakerloo, Circle, Hammersmith and City, Jubilee, Metropolitan)&quot;,&quot;Finchley Road (Jubilee, Metropolitan)&quot;,&quot;Wembley Park (Jubilee, Metropolitan)&quot;]

Access the public API

Behind the next window, you'll find the public API! If you've have setup your map server, you can access the service through an API, using the distribution: Map::Tube::API. First set the MAP_BASE_URL environment variable.

$ export MAP_BASE_URL=http://127.0.0.1:5000

Now let's create a script, map-api.pl, to make the API call:

use v5.40;
use Data::Dumper;
use Map::Tube::API;

my $api = Map::Tube::API-&gt;new;
say Dumper($api-&gt;shortest_route({ map =&gt; &#39;london&#39;, start =&gt; &#39;Baker Street&#39;, end =&gt; &#39;Wembley Park&#39; }));

It's time to make that API call:

$ perl map-api.pl
$VAR1 = [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#39;Baker Street (Bakerloo, Circle, Hammersmith and City, Jubilee, Metropolitan)&#39;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#39;Finchley Road (Jubilee, Metropolitan)&#39;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&#39;Wembley Park (Jubilee, Metropolitan)&#39;
];

How about other maps? Open a new city!

Ready for a new adventure? Open the next window to discover how to install other city maps. To install a map, like Delhi, just do the following:

$ cpanm -v Map::Tube::Delhi

Or, if you're feeling adventurous and want to explore all the maps, use the distribution Task::Map::Tube::Bundle to install them all at once.

$ cpanm -v Task::Map::Tube::Bundle

Programming like a BEAST

2024-12-10T00:00:00Z

Enhance Your Development Workflow with the e Module

You know how certain aspects of development can be a real drag - slow and pretty boring? I’ve definitely been there. But here’s where the e module comes in and changes the game.

Rapid Prototyping

The e module comes loaded in with many features that can aid in rapid prototyping as well as testing.

Let's Make Selenium Testing Less Painful Again

One of its cool features is the repl breakpoint command, which can seriously simplify debugging and testing processes across the board.

It can also be used from the command line like this:

perl -Me -e 'my $var = 111; repl'

With that simple one-liner, you trigger an interactive breakpoint which pauses the execution of the program.

You can investigate data and try things out.

Once satisfied, you can quit the debugger and code flow would continue as usual.

So, instead of dealing with all the usual hassle of setting "breakpoints" and debugging manually (yes, I taking about you print), you can use e to just pop in a breakpoint whenever you need it. This means you can pause execution, check out what’s going on, and make adjustments on the fly.

A prime example of where e shines is in Selenium testing, where it can significantly ease the process. Selenium tests can be notoriously slow and cumbersome, but the repl breakpoint feature makes it less painful.

However, it’s not just for Selenium, e can enhance various development tasks by making the whole debugging and testing experience accelerated, quickly done, and, dare I say, even a bit enjoyable.

More Tricks up its Sleeve

Besides making a fancy breakpoint, e can a wide array of tricks to help one in common daily tasks.

The Obnoxious Say

Have you ever added a print statement, only to realize that there is no output for some reason? (Assuming you have no syntax errors).

Now, imagine working in a large, complex codebase where, buried deep within a function, STDOUT or STDERR is being closed.

close STDOUT;
open STDOUT, '&gt;', '/dev/null';

say &quot;You wont ever see this :(&quot;;

So you now need to find the place that closes STDOUT to comment it out for debugging or figure out how to print it to the screen (maybe there is a --verbose option).

Say Hello to the Obnoxious Say

use e;

print &quot;You'll see this.\n.&quot;;
say &quot;And this&quot;;

close *STDOUT;
close *STDERR;

print &quot;But not this.\n&quot;;
say &quot;YOU'll STILL SEE THIS!&quot;;

Whether your output streams are open, closed, or redirected, the obnoxious say will always ensure the message gets displayed on your screen.

Pod Table Of Contents

Need a quick overview of a Perl module? Well, the pod command-line tool (included with e is your friend.

Using it you can get a quick overview of a module:

- Methods names and summaries. - Module inheritance. - Jump into the module quickly (via Vim).

At a glance I can see what methods are available for a module.

For Mojo::UserAgent

For Mojo::JSON

Can also look at a specific method:

Using the edit option you can also jump inside the module file to explore how it works:

(In that case above, need to press n again to find the actual definition of the method)

Performance Efficiency

Worried about performance? Well, stop it! e has been optimized to have a very tiny footprint to conserve space and resources. Also, it makes great use of Just In Time (JIT) module loading: you pay only for what you use. For instance, I use it on my smartphone with Termux, and it’s incredibly fast - even with the phone's limited resources. The impact is practically negligible, and it runs smoothly without any noticeable delays.

Interactive Demos

To see e in action, just install it with cpan(m):

cpanm e

Then skim through the short doc.

You can also try out this Perl Banjo interactive demo. You can run a few example snippets and experiment with them directly.

Feel free to modify the snippets on the right to explore different features and see how e can enhance your own development workflow.

(Unfortunately, at this time, not all features can be currently used in PerlBanjo.)

Your Turn

With the power of e at your fingertips, it’s time to dive in and explore! Whether you’re easing the pain of Selenium testing, ensuring your output is always present with the obnoxious say, or seamlessly navigating documentation using pod, e is here to transform your experience. Try it out and see how it fits into your workflow!

A Time-Tested Powerhouse for Processing XML

2024-12-09T00:00:00Z

XML was the preferred communication language used by services in the early 2000s. During that time, governments were establishing their own e-government systems, while companies were developing their SOAP services. Then, BOOM! Services began to adopt JSON because it was a lightweight and efficient alternative to XML. However, even though JSON became the new standard, old services were still in use and being maintained.Rewriting a system from scratch is not easy, and it might not even be necessary. That might be why XML is still in use, or perhaps governments and companies simply adopt the "as far as it goes" mindset. Who knows! Let's parse some XML and beat that services up!

Here is where the sweetest and most beloved Perl library, XML::Twig, comes into play.

Parsing XML File

Suppose we provide a service to manage internet access for a hotel’s guests. The hotel's property management system stores its guests in a file using XML. We need to read that file in order to check if the user is a guest of the hotel. In order to gain access to internet a user should type their id and wifi password correctly.

The following is the XML format:

&lt;?xml version=&quot;1.0&quot; encoding=&quot;UTF-8&quot;?&gt;
&lt;guestList&gt;
&nbsp;&nbsp;&lt;guest room=&quot;201&quot; wifiKey=&quot;ryan1234&quot; name=&quot;Michael&quot; surname=&quot;Scott&quot; idType=&quot;P&quot; id=&quot;CB5634431&quot; gender=&quot;M&quot; country=&quot;USA&quot; checkIn=&quot;2024-11-29 14:03:23&quot; checkOut=&quot;&quot;&gt;&lt;/guest&gt;
&nbsp;&nbsp;&lt;guest room=&quot;202&quot; wifiKey=&quot;X0K7F2ie!&quot; name=&quot;Dwight&quot; surname=&quot;Schrute&quot; idType=&quot;P&quot; id=&quot;AB3056430&quot; gender=&quot;M&quot; country=&quot;USA&quot; checkIn=&quot;2024-11-29 14:03:23&quot; checkOut=&quot;&quot;&gt;&lt;/guest&gt;
&nbsp;&nbsp;&lt;guest room=&quot;305&quot; wifiKey=&quot;SNbsnz&quot; name=&quot;Selim Serhat&quot; surname=&quot;Celik&quot; idType=&quot;TC&quot; id=&quot;00011122233&quot; gender=&quot;M&quot; country=&quot;TR&quot; checkIn=&quot;2024-11-29 14:03:23&quot; checkOut=&quot;&quot;&gt;&lt;/guest&gt;
&nbsp;&nbsp;&lt;!-- Other guest entries can follow here --&gt;
&lt;/guestList&gt;

This file is located at hotelpms/guests.xml. To parse file we need to provide this file path to parsefile function, the library also has a function named parse. According to documentation if your job is with file you should use parsefile but if you want to parse a string that contains whole XML document then you could use parse.

use strict;
use warnings;
use diagnostics;
use XML::Twig;

sub check_guest {
&nbsp;&nbsp;my $id = shift;
&nbsp;&nbsp;my $password = shift;

&nbsp;&nbsp;my $twig = XML::Twig -&gt; new();
&nbsp;&nbsp;$twig -&gt; parsefile( &quot;/hotelpms/guests.xml&quot;) || # handle error;

}

In order to access guest tags, we first need to obtain guestList, which is the root of this XML document. The $twig->root method returns the direct parent of all other elements. On the other hand, the children method returns list of elements. The method can take an optional argument. If a string is passed to the method, XML elements that match the string will be fetched; otherwise, all elements of the current root will be fetched in document order. The returned list contains elements that are instances of the XML::Twig::Elt class. So, this means you can perform any operations that the XML::Twig::Elt class allows.

As you can see, information we are looking for is the attributes of the XML element tag. To reach the name of a person we must access name attribute. XML::Twig::Elt has various functions on attributes. The att method will do the job. To note that, because the XML we have is automatically generated by another system, so we haven't checked if the element has the attribute. To check if an element has a specific attribute, you can call the att_exist it will return true if the attribute exists for the element, false otherwise.

sub check_guest {
  # previous lines above

&nbsp;&nbsp;my @guests = $twig-&gt;root-&gt;children('guest');
  # $guests[0]-&gt;att('name') will return Michael
}

If we put all the information we’ve discussed together, the function would look like this.

sub check_guest {
&nbsp;&nbsp;my $id = shift;
&nbsp;&nbsp;my $password = shift;

&nbsp;&nbsp;my $twig = XML::Twig-&gt;new();
&nbsp;&nbsp;$twig-&gt;parsefile( &quot;/hotelpms/guests.xml&quot; ) || return 0; # handle error
&nbsp;&nbsp;my @guests = $twig-&gt;root-&gt;children('guest');

&nbsp;&nbsp;foreach my $guest (@guests) {
&nbsp;&nbsp;&nbsp;&nbsp;return 1 if (($guest -&gt; att('id') eq $id) &amp;&amp; ($guest -&gt; att('wifiKey') eq $password));
&nbsp;&nbsp;}

&nbsp;&nbsp;return 0;
}

Parsing XML Response

Suppose that there are servers somewhere in this universe. We don't know exactly when the answer will be returned it changes depending on the data of our request, but we know the exact XML response format. It is said that this server provides answers about the Earth's past based on what it observes. So, demanding information related to an much earlier date will take much longer to travel due to the speed of light and it is open anyone to send request. A researcher wants to find out why the stones at Gobeklitepe were buried. Researcher knows that when the answer reach researcher will not be alive. All conditions have been maintained for the message to return, and a system was designed to await all requests by some world organization. The language selected was Perl.

Here is expected response format:

HTTP/1.1 200 OK
Content-Type: text/xml; charset=utf-8
Content-Length: length

&lt;?xml version=&quot;1.0&quot; encoding=&quot;utf-8&quot;?&gt;
&lt;soap:Envelope xmlns:xsi=&quot;http://www.w3.org/2001/XMLSchema-instance&quot; xmlns:xsd=&quot;http://www.w3.org/2001/XMLSchema&quot; xmlns:soap=&quot;http://schemas.xmlsoap.org/soap/envelope/&quot;&gt;
&nbsp;&nbsp;&lt;soap:Body&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;observeResult xmlns=&quot;http://universe.com/&quot;&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;query&gt;string&lt;/query&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;observation&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;year&gt;int&lt;/year&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;nation&gt;string&lt;/nation&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;purpose&gt;string&lt;/purpose&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;details&gt;string&lt;/details&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;/observation&gt;
&nbsp;&nbsp;&nbsp;&nbsp;&lt;/observeResult&gt;
&nbsp;&nbsp;&lt;/soap:Body&gt;
&lt;/soap:Envelope&gt;

The first_child function in the XML::Twig module is used to retrieve the first child element of the current element in the XML document. XML::Twig::Elt class has text method that extracts the content from inside tag.

use strict;
use warnings;
use diagnostics;
use XML::Twig;
use LWP::UserAgent;

my $ua = LWP::UserAgent-&gt;new();
my $req = HTTP::Request-&gt;new(POST =&gt; &quot;http://universe.com?query=gobeklitepe&quot; );
$req-&gt;content_type('text/XML; charset=utf-8');
$req-&gt;header(SOAPAction =&gt; 'http://universe.com/observations');

my $res = $ua-&gt;request($req);

my $xml_response = undef;

if ($res -&gt; is_success) {
&nbsp;&nbsp;$xml_response = $res-&gt;content;
}

my $twig = XML::Twig-&gt;new();
$twig -&gt; parse($xml_response) || die &quot;Unable to parse XML document&quot;;

my $observation = $twig-&gt;root-&gt;first_child('soap:Body')-&gt;first_child('observeResult')-&gt;first_child('observation');

# Reaching observation data one by one
my $year = $observation-&gt;first_child('year')-&gt;text;
my $nation = $observation-&gt;first_child('nation')-&gt;text;
my $purpose = $observation-&gt;first_child('purpose')-&gt;text;
my $details = $observation-&gt;first_child('details')-&gt;text;

Happy holidays!

Pixie the Elf Picks an Artist: Exploring Perl's new class syntax

2024-12-08T00:00:00Z

The Problem: Repetitive Artists

Pixie the Elf (whose parents had strange ideas about names), was well-known at the North Pole for her love of music. But she often found herself in a bit of a repetitive loop. It was just too easy to listen to the same artists over and over again. With 15 years of meticulously scrobbled data on Last.fm, she wondered if she could leverage this information to diversify her playlists. Determined to find a solution, Pixie delved into the Last.fm API and, after some coding, developed pickanartist, a Perl program designed to recommend artists she hadn't engaged with recently.

Using PickAnArtist

To break free from her musical monotony, Pixie used PickAnArtist as follows:

Setup: She cloned the PickAnArtist repository from GitHub and ensured all necessary dependencies were installed.
Configuration: Pixie set her Last.fm username and defined thresholds for minimum and maximum play counts to filter artists.
Execution: By running the script with her username, the program fetched her listening data, filtered artists based on the specified play counts, and randomly selected an artist for her to revisit:
```
    pickanartist --user=pixiethelf --min=500 --max=1000
```
Outcome: The script displayed the name of an artist within the specified play count range, prompting Pixie to explore their music anew.
```
    Belle &amp; Sebastian (978 plays)
```
Pixie found their latest album on ElfTunes and added it to her play queue.

How `pickanartist` works

The pickanartist program comprises two main components:

The Command-Line Program: Handles user input and initializes the process.
The Perl Class: Encapsulates the core functionality, utilizing Perl's modern class syntax.

The command-line program

The command-line program doesn't do anything complicated, it just creates an object of class App::LastFM::PickAnArtist (using values passed on the command line) and calls its run() method.

The class

The core functionality is all in the class - called App::LastFM::PickAnArtist. Pixie had written many Perl classes in her time, but she decided to use this as an excuse to try out the new Perl class syntax that had been introduced in Perl 5.38 and that is documented in perlclass.

Normally, you would tell the Perl compiler that you were using the new class syntax by adding use feature 'class' to your code. But Pixie had read about Feature::Compat::Class which makes the syntax available on earlier versions of Perl (as far back as 5.14) and she wanted to use that in case one of her less up-to-date gnome colleagues wanted to use her code.

The first nice thing about the new syntax was that you could replace the package keyword with class - to better define what the code was. So Pixie's file started like this:

use Feature::Compat::Class;

class App::LastFM::PickAnArtist;

She then added a feature she needed along with a useful module:

use feature 'say';
use Net::LastFM;

The next new keyword was field, which you use to define attributes of the class (like has in Moo or Moose). But in the new syntax, you're defining something more like a lexical (my) variable that can be read by all methods inside the class. You can also add the :param attribute to define the field as something that can be passed to the object constructor, along with an expression to define a default value for the field.

Pixie's three parameter fields looked like this:

field $username :param = 'pixietheelf';
field $min :param = 500;
field $max :param = 1000;

She then added a few more fields that would be useful when running the code:

field $lastfm = Net::LastFM-&gt;new(
&nbsp;&nbsp;api_key    =&gt; $ENV{LASTFM_API_KEY},
&nbsp;&nbsp;api_secret =&gt; $ENV{LASTFM_API_SECRET},
);
field $method = 'user.getTopArtists';
field @artists;
field $artist;

Looking back over the code, Pixie added a TODO comment reminding herself that she should really deal with the case when the environment variables weren't set. She'd do that... one day.

Next, Pixie came to the methods for her class. There were three main differences to the OO Perl she had written before. Firstly, she could define methods with a method keyword. Secondly, each method has access to the class fields - and you can just treat them like variables. And, finally, each method automatically has access to a $self variable - without having to read it from the arguments!

The first method was simple:

method run {
&nbsp;&nbsp;$self-&gt;getartists;
&nbsp;&nbsp;$self-&gt;pickartist;
&nbsp;&nbsp;$self-&gt;render;
}

Pixie was following good programming design practice here. She broke the problem down into simpler steps. One to get the artists from the LastFM API, one to pick an artist to recommend and one to display the results to the user.

The next method was the most complex:

method getartists {
&nbsp;&nbsp;my $data;
&nbsp;&nbsp;my $page = 1;
&nbsp;&nbsp;do {
&nbsp;&nbsp;&nbsp;&nbsp;$data = $lastfm-&gt;request_signed(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;method =&gt; $method,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;user   =&gt; $username,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;page   =&gt; $page,
&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;for (@{$data-&gt;{topartists}{artist}}) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next if $_-&gt;{playcount} &gt; $max;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next if $_-&gt;{playcount} &lt; $min;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @artists, $_;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;++$page;
&nbsp;&nbsp;} until $data-&gt;{topartists}{artist}[-1]{playcount} &lt; $min;

&nbsp;&nbsp;die &quot;No artists with between $min and $max plays for $username\n&quot;
&nbsp;&nbsp;&nbsp;&nbsp;unless @artists;
}

This is where Pixie makes the actual call to the LastFM API. Most of the complexity is caused by LastFM paging the data it gives you, so you might need to make multiple calls in order to get all the data you want.

But at the end of this method, the @artists field contains one element for each artist the user has listened to between the minimum and maximum requested number of times.

The last two methods are so simple, that Pixie hesitated to even make them methods:

method pickartist {
&nbsp;&nbsp;$artist = $artists[ rand @artists ];
}

method render {
&nbsp;&nbsp;say &quot;$artist-&gt;{name} ($artist-&gt;{playcount})&quot;;
}

Pixie's code is available on GitHub - github.com/davorg/pickanartist

Embracing Modern Perl

Pixie is happy with the way the code worked out. She thinks that the new syntax makes her code far easier to read, maintain and extend. She particularly like the way that the fields looked and acted like ordinary variables. This made a lot of code far simpler. Under "classic" Perl class syntax (and even with Moo or Moose) you would access the value of an attribute by using its accessor with code like this:

say &quot;The username is &quot;, $self-&gt;username;

Or, maybe you would directly access the hash reference with code like this:

say &quot;The username is $self-&gt;{username}&quot;;

In the first case, you're using a subroutine which you can't easily use in a string. In the second case, you're relying on the internal representation of the class which breaks encapsulation.

But the new syntax simplifies that to:

say &quot;The username is $username&quot;;

The field looks and acts just like a variable, so you can easily use it in a string and you don't need to know anything about the internals of the class to access the value.

This syntax is a work in progress. It was first introduced with Perl 5.38 in 2023 and Perl 5.40 added a few more features (for example, it will now auto-generate an accessor method for any field with the attribute :reader) and it will, no doubt, gain more functionality when Perl 5.42 is released next year.

That said, it isn't complete. It doesn't yet support roles and (for obvious reasons) it's missing the huge ecosystem of plugins and extensions that Moo/se has accumulated over the last twenty years.

But don't let that stop you from trying it out. Pixie didn't need to use all of the features it currently has - so it can already do a lot more than is shown in her code.

Conclusion

Pixie’s story demonstrates how modern Perl features and powerful APIs like Last.fm can combine to solve real-world problems in elegant ways. Whether you’re a seasoned Perl hacker or just getting started, the perlclass syntax makes it easier than ever to write maintainable, feature-rich code.

So, take a leaf out of Pixie’s book—or in this case, her playlist—and let Perl help you create something fun, practical, and uniquely yours.

Happy coding, and may your playlists stay diverse and delightful!

Keeping the Elves Busy

2024-12-07T00:00:00Z

Christmas Crisis

Already well into advent, Santa's elves were busy in the workshop, checking lists, wrapping presents, and preparing for the big night. That was the plan anyway. But as Santa popped his head around the door, he saw that most of the elves were standing around looking at their phones or playing games with Rudolph. Because the other reindeer wouldn't.

"What's going on?" asked Santa. "Why isn't everyone working?"

"Well," explained Holly, the project manager, "this legacy inventory software we're using is single-threaded, so it can only handle one job at a time." She explained that the elves took it in turns to pick up a new job, work on it and then mark it as completed. But for the rest of the time there was nothing for them to do.

"We've asked our supplier to update the software," she continued, "since we've got all these CPUs on our server just sitting there doing nothing. But they told us it would cost $44 billion, and who has that sort of money? At this rate we'll never get the presents ready by Christmas Eve."

Parallel::ForkManager to the Rescue

Santa considered the problem. Holly was correct, the server had plenty of spare capacity. So Santa checked out the repository and fired up his editor. He came across this method:

sub process_presents ($self) {
&nbsp;&nbsp;while (my $present = $self-&gt;get_next_present) {
&nbsp;&nbsp;&nbsp;&nbsp;$present-&gt;process;
&nbsp;&nbsp;}
}

"Aha!" thought Santa, "this is the bottleneck." Just as Holly had explained, the software couldn't process a new present until the previous one had been completed.

So Santa installed Parallel::ForkManager and changed the method to this:

sub process_presents ($self) {
&nbsp;&nbsp;my $pm = Parallel::ForkManager-&gt;new(6);
&nbsp;&nbsp;while (my $present = $self-&gt;get_next_present) {
&nbsp;&nbsp;&nbsp;&nbsp;$pm-&gt;start and next;
&nbsp;&nbsp;&nbsp;&nbsp;$present-&gt;process;
&nbsp;&nbsp;&nbsp;&nbsp;$pm-&gt;finish;
&nbsp;&nbsp;}
&nbsp;&nbsp;$pm-&gt;wait_all_children;
}

The Elves Get Back to Work

A quick test showed that all six elves were now kept busy.

Santa asked Mrs Claus to review the code. He explained that Parallel::ForkManager is a module that wraps perl's native fork function, allowing multiple processes to run in parallel. It is simple to use and has an API which adds additional features.

With the new code, six presents could be processed at once - one for each elf. The line my $pm = Parallel::ForkManager->new(6); creates a new instance of the Parallel::ForkManager class, allowing a maximum of six concurrent child processes.

The start method is called on the object to fork off a new child process. As with the core fork function, the method returns the pid of the child process to the parent and 0 to the child. So adding and next means that the parent process immediately starts the next iteration of the loop. If there are alreadxy six child processes running, the parent will wait for one to finish before starting a new one.

The child process processes the present and then calls the finish method to end the child process.

The wait_all_children method is called after the loop to wait for all child processes to finish before the method returns.

Mrs Claus was impressed with the new code, but suggested that Santa added error handling, tests and documentation.

Santa's Work is Done

With Santa's changes in production the elves were back to work and the project was back on schedule. Christmas was saved!

Holly read through the documentation for Parallel::ForkManager and noticed the API included methods such as run_on_finish and run_on_wait. She added new tickets to use these methods to provide metrics to power a bunch of really exciting dashboards.

Everyone was happy. Except for Rudolph.

Have Yourself an AI Christmas!

2024-12-06T00:00:00Z

Ah for the good old days, when every Christmas season my family would gather in front of the roaring hearth, our glue, glitter, paint brushes, pens and card stock all spread out as we lovingly created personal Christmas cards for our friends and family.

But who has time for that now? Nowadays, if my family sends out cards at all, we buy them in bulk at the local stationery store.

Santa would not approve.

AI to the Rescue!

We've already surrendered our coding to Copilot, our research to ChatGPT, and have replaced our real-life friends with simulated personalities on Character.ai. So why not let AI do our Christmas greetings for us?

OpenAI::API to the rescue! This handy-dandy Perl module exposes OpenAI's API to Perl, and lets you do chat, text completion, and image generation from the command line. What we're going to do is:

1. Get a description of the type of card to generate and (optionally) the name of its recipient.
2. Call OpenAI's chat API to turn the description into an image generation prompt.
3. Call OpenAI's image generation API to generate an image from the prompt and store it online.
4. Use Browser::Open to display the image in your favorite web browser.

When you run the script it does this:

   &gt; perl merry_xmas.pl &quot;A humorous card for my Uncle Jim, who loves cats&quot;
   The AI elves are hard at work (tippity tappity)...done!

Your browser will then open up and display something like this:

Prerequisites

For this script to work, you'll need to install the Browser::Open and OpenAI::API modules from CPAN. You'll also need to register an OpenAI account, get an API key, and add the key to your environment using the name OPENAI_API_KEY. Instructions for this can be found at https://platform.openai.com/docs/quickstart.

The Main Script!

Here's the main script. Save it as merry_xmas.pl:

#!/usr/bin/env perl
use strict;
use warnings;

use lib './lib';
use Browser::Open 'open_browser';
use ChristmasCard;

die &lt;&lt;END unless @ARGV;
Usage: $0 &quot;card description&quot;
&nbsp;&nbsp;&nbsp;Generate a Christmas card from a brief description.
&nbsp;&nbsp;&nbsp;If the description contains the recipient's name, the name will
&nbsp;&nbsp;&nbsp;be incorporated in the card's greeting.
END

my $description = &quot;@ARGV&quot;;

print STDERR &quot;The AI elves are hard at work (tippity tappity)...&quot;;
my $url = ChristmasCard-&gt;make_card($description);
print STDERR &quot;...done!\n&quot;;

open_browser($url);

This script imports the ChristmasCard.pm module which does the actual work. It then uses @ARGV to read the description of the card from the command line and passes it to the ChristmasCard->make_card() method. This method returns a URL to the image and passes it to the Browser::Open open_browser() function to display the image. You can then download the image, attach it to an email, etc.

The ChristmasCard library

The second and last piece is the ChristmasCard library. Save this file as ChristmasCard.pm in a subdirectory named lib.

#########################################################3
package ChristmasCard::Request::ImageGenerator;

use Types::Standard qw(Str Enum);

use Moo;
use strictures 2;
use namespace::clean;

extends 'OpenAI::API::Request::Image::Generation';

has model   =&gt; ( is =&gt; 'ro', isa =&gt; Str, );
has quality =&gt; ( is =&gt; 'ro', isa =&gt; Enum [ 'standard', 'hd' ], );

#########################################################3
package ChristmasCard::Response::ImageGenerator;
use strictures 2;
use Moo;

extends 'OpenAI::API::Response::Image::Generation';

has 'revised_prompt' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;&nbsp;required =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;);

#########################################################3
package ChristmasCard;

use strict;
use warnings;
use OpenAI::API::Request::Chat;

sub make_card {
&nbsp;&nbsp;&nbsp;&nbsp;my $class = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $description = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $prompt = $class-&gt;make_prompt($description);
&nbsp;&nbsp;&nbsp;&nbsp;return $class-&gt;make_image($prompt);
}

sub make_prompt {
&nbsp;&nbsp;&nbsp;&nbsp;my $class = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $description = shift || 'A nostalgic illustration typical of Christmases past.';
&nbsp;&nbsp;&nbsp;&nbsp;my $prompt =&lt;&lt;END;
Please generate a text prompt in 120 words or less that can be passed to
the OpenAI image generator to generate the illustration for a Christmas card.
If the name of the recipient is mentioned in the description, write out
&quot;Merry Christmas &lt;recipient&gt;&quot;.

The following text describes the image:

$description
END

&nbsp;&nbsp;&nbsp;&nbsp;my $req = OpenAI::API::Request::Chat-&gt;new(
&nbsp;model =&gt; 'gpt-4o-mini',
&nbsp;messages =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{role =&gt; &quot;system&quot;, &quot;content&quot; =&gt; &quot;You are a helpful assistant.&quot;},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{role =&gt; &quot;user&quot;,   &quot;content&quot; =&gt; $prompt},
&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;my $resp = $req-&gt;send();
&nbsp;&nbsp;&nbsp;&nbsp;return $resp-&gt;{choices}[0]{message}{content};
}

sub make_image {
&nbsp;&nbsp;&nbsp;&nbsp;my $class = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $prompt = shift or die &quot;Usage: \$card-&gt;image(\$prompt)&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;my $req = ChristmasCard::Request::ImageGenerator-&gt;new(
&nbsp;model  =&gt; 'dall-e-3',
&nbsp;prompt =&gt; $prompt,
&nbsp;quality =&gt; 'hd',
&nbsp;n =&gt; 1,
&nbsp;response_format =&gt; 'url',
&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;my $resp = $req-&gt;send();
&nbsp;&nbsp;&nbsp;&nbsp;return $resp-&gt;{data}[0]{'url'};
}

1;

Ignore the first few blocks of code at the top of the file for now, and take a look at the section that begins with package ChristmasCard;. This package begins by importing OpenAI::API::Request::Chat, which is the programmatic interface to ChatGPT. It then defines the top-level method, make_card(). This method takes the card description provided by the user, and passes it to a method called make_prompt() which calls ChatGPT to take the description and turn it into a full image prompt suitable for generating a christmas card. For example, if the prompt is "A humorous card for my Uncle Jim, who loves cats", the resulting prompt might be something along the lines of:

  A whimsical Christmas card design featuring a cozy living room
  scene. In the center, a fluffy cat wearing a Santa hat is playfully
  tangled in colorful Christmas lights. Surrounding the cat are
  cheerful holiday decorations, including a beautifully decorated
  tree, stockings hung by the fireplace, and a few playful kittens
  peeking out from under the tree. Snow gently falls outside the
  window, creating a warm, festive atmosphere. The text at the top
  reads, &quot;Merry Christmas Uncle Jim!&quot; in playful, bold letters. The
  overall vibe should be humorous and heartwarming, perfect for a
  cat-loving uncle.

This prompt is now passed to the make_image() method, which generates the image and returns its URL.

Let's have a look at the make_prompt() method. It adds a preface to the card description that tells ChatGPT what we're aiming for. The resulting instruction passed to ChatGPT will look like this:

  Please generate a less than 120 words text prompt that can be passed
  to the OpenAI image generator to generate the illustration for a
  Christmas card.  If the name of the recipient is mentioned in the
  description, write out &quot;Merry Christmas &lt;recipient&gt;&quot;.

  The following text describes the image:

  A humorous card for my Uncle Jim, who loves cats

We now open a new chat connection using OpenAI::API::Request::Chat->new(), and specify the language model to use and the messages to send to it. In this case, we use the gpt-4o-mini model, and pass the language model a context-setting message of "You are a helpful assistant" followed by the instruction we generated earlier. We then call the resulting object's send() method, and return the content of the language model's response. (The response object is actually a nested set of hashes that contains a lot of metadata about the transaction in addition to the response itself.)

Let's look at the make_image() method, which generates the image. We take the image-generation prompt from the previous step, and pass it to ChristmasCard::Request::ImageGenerator->new(). In addition to the prompt, we pass arguments for the AI model to use (dall-e-3), the quality of the image (hd for high definition), the number of images to generate, and the response_format. You can either request a URL or the actual image data. We choose the url format because it is easier to deal with.

We then call the returned request object's send() method to get a response, navigate to the URL nested deep inside the response object like a chocolate Santa in a stocking, and return it.

Now we'll talk about the two packages defined at the top of ChristmasCard.pm, one named ChristmasCard::Request::ImageGenerator and the other named ChristmasCard::Response::ImageGenerator. The OpenAI::API module is equipped with a class called OpenAI::API::Request::Image::Generation which handles image generation requests. Unfortunately this module is a bit out of date and neither handles the newer dall-e-3 model nor supports the hd format, both of which generate much nicer cards than the older versions.

Fortunately the OpenAI module is well-designed and easy to extend. The ChristmasCard::Request::ImageGenerator module, imported at the top of ChristmasCard.pm, extends OpenAI::API::Request::Image::Generation to define two new generation parameters: model and quality. We use the Moose subclassing mechanism, which provides the extends operator to generate a subclass of OpenAI::API::Request::Image::Generation, and the has operator to add two new typed accessors to the ChristmasCard::Request::ImageGenerator class.

OpenAI::API requires every request generator to have a corresponding response parser. We define ChristmasCard::Response::ImageGenerator to be a subclass of OpenAI::API::Response::Image::Generation, and add a new revised_prompt accessor to it in order to accommodate a new field returned by the dall-e-3.

Conclusion

And there you have it! Now, if you're ambitious -- or maybe just lazy -- you can create a text file of friend and family names and their personal idiosyncrasies. Read from the file, write a little loop around ChristmasCard->make_card(), and get all your Christmas cards done in two shakes of the Easter bunny's tail.

Time to hit the eggnog!

Santa's Naughty and Nice Data Formats

2024-12-05T00:00:00Z

Santa's Naughty and Nice Data Formats

Santa faces some of the same technology issues that many of us have faced. After a succession of elves half-implemented a reindeer tracking system, his reindeer database is in a sad state, there's nobody to fix it, and his naughty list has a special section for people who create dirty data.

Now he needs to fix up his records so he can generate the reports his compliance elves keep hassling him about (a whole other thing—don't ask). That same compliance team also makes Santa use auditable source control, so his data and programs are in GitHub.

One file, data/donner.json, started with this data:

{
&nbsp;&nbsp;&quot;Name&quot;: &quot;Donner&quot;,
&nbsp;&nbsp;&quot;aliases&quot;: [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Dunder&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Donder&quot;
&nbsp;&nbsp;],
&nbsp;&nbsp;&quot;start-date&quot;: &quot;1823-12-24&quot;
}

Another file, data/rudolph.json, has similar data but with slightly different field names and a different date format. This one must have come from the new interns who had to guess what to do because there aren't any docs:

{
&nbsp;&nbsp;&quot;name&quot;: &quot;Rudolph&quot;,
&nbsp;&nbsp;&quot;start_date&quot;: &quot;12/24/1939&quot;
}

These differences mean that some reindeers are left out of some of the reindeer games because their records are simply skipped.

Enter Data::Rx

At first this seems like a simple problem of checking each hash to ensure it has the right set of keys. The same goes for its values. That could be its own Perl program. But, as the data structure gets more and more complicated, so does the code. Santa is an old-school, zero-conf, minimal code sorta guy.

Data::Rx provides a way to declare what a data structure should look like and what sort of values it should have. Santa knows it's going to take a minute to clean up all of his files, so he'll start with two things he knows. He wants the fields to be name and start_date. He creates his Rx specification as a Perl data structure:

my $record = {
&nbsp;type     =&gt; '//rec',
&nbsp;required =&gt; {
&nbsp;&nbsp;name       =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;start_date =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;},
&nbsp;};

This says that there is a record type (think "hash"), that there are two required keys, and that the values for those keys are strings. This Perl data structure is the basis for the schema that Data::Rx creates and which Santa then uses to validate a data structure:

&nbsp;use Data::Rx;
&nbsp;my $rx = Data::Rx-&gt;new;
&nbsp;my $schema = $rx-&gt;make_schema($record);

&nbsp;eval { $schema-&gt;assert_valid($data) };

Putting that together with the boring programming work gets Santa his starting program:

use v5.14;

use Data::Rx;
use Mojo::File;
use Mojo::JSON;

my $record = {
&nbsp;type     =&gt; '//rec',
&nbsp;required =&gt; {
&nbsp;&nbsp;name       =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;start_date =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;},
&nbsp;};

my $rx = Data::Rx-&gt;new;
my $schema = $rx-&gt;make_schema($record);

foreach my $file ( sort @ARGV ) {
&nbsp;say &quot;Checking $file&quot;;

&nbsp;my $data = eval { Mojo::JSON::decode_json( Mojo::File-&gt;new($file)-&gt;slurp ) };
&nbsp;unless( $data ) {
&nbsp;&nbsp;my $error = $@ =~ s/\.^/\n/gmr;
&nbsp;&nbsp;say &quot;\tCould not read &lt;$file&gt;: $error&quot;;
&nbsp;&nbsp;next;
&nbsp;&nbsp;}

&nbsp;eval { $schema-&gt;assert_valid($data) };
&nbsp;my $at = $@;
&nbsp;next unless length $at;

&nbsp;foreach my $failure ( @{ $at-&gt;failures } ) {
&nbsp;&nbsp;say &quot;\t$failure&quot;;
&nbsp;&nbsp;}
&nbsp;};

Santa runs his program on a couple of the files, knowing he's going to get several errors. Just with the two files shown earlier, Santa finds that there are some misnamed fields ("unexpected entries") and missing values for required entries:

&nbsp;$ perl bin/validate data/rudolph.json data/donner.json
&nbsp;Checking data/donner.json
&nbsp;&nbsp;Failed //rec: found unexpected entries: Name aliases start-date (error: unexpected at $data)
&nbsp;&nbsp;Failed //rec: no value given for required entry start_date (error: missing at $data)
&nbsp;&nbsp;Failed //rec: no value given for required entry name (error: missing at $data)
&nbsp;Checking data/rudolph.json

He'll fix these up in a moment, but he has to run out to the workshop to handle a slow down on the toy train assembly line. That gives you some time to investigate Rx.

The Rx Language

The Rx language allows us to easily specify basic structure as well as extend it for more complex types. The Data::Rx module implements this for Perl, but the language can be implemented in anything (and just about is). We can write out our specification in just about anything too, but we'll stick to Perl for now.

In Perl, this starts with a hash with the key type to specify what the first element should be. In this case, the type is //rec, the Rx name for a hash (dictionary, map, JSON object, and so on):

my $record = {
&nbsp;type =&gt; '//rec',
&nbsp;};

There are many other types, but at the top level you probably have a //rec, //arr (array), //map (all values are the same type), or a //seq (sequence).

Next, we can specify the required keys, and specify the value that each of these keys takes. Each of the values is another Rx specification, and in this case, each of them is a string (//str):

my $record = {
&nbsp;type     =&gt; '//rec',
&nbsp;required =&gt; {
&nbsp;&nbsp;name       =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;start_date =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;},
&nbsp;};

Once we have our schema, we tell Data::Rx to create the Perl object we can use to validate the data:

my $rx = Data::Rx-&gt;new;
my $schema = $rx-&gt;make_schema($record);

To apply the schema to a Perl data structure, we call assert_valid, which throws an exception if the validation fails:

eval { $schema-&gt;assert_valid($data) };

There's also a binary check, but that only reports yes or no. That could be valuable in some cases, such as when we don't want to see thousands of lines of errors in continuous integration.

But now Santa has got the toy trains running again, so he's back to working on his data problems.

Fixing the data errors

Santa fixes up the field names easily enough to get the new data/donner.json:

{
&nbsp;&nbsp;&quot;aliases&quot;: [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Dunder&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;Donder&quot;
&nbsp;&nbsp;],
&nbsp;&nbsp;&quot;name&quot;: &quot;Donner&quot;,
&nbsp;&nbsp;&quot;start_date&quot;: &quot;1823-12-24&quot;
}

Some of the errors, but he still has an error for the aliases key:

&nbsp;$ perl bin/validate data/rudolph.json data/donner.json
&nbsp;Checking data/donner.json
&nbsp;&nbsp;Failed //rec: found unexpected entries: Name aliases (error: unexpected at $data)
&nbsp;Checking data/rudolph.json

To handle aliases, Santa needs to specify an array. In Rx, an array has values that are all the same type (say, all strings). Santa extends his specification a little. He makes the aliases field optional. It's okay if Donner has aliases (more than one even), and it's okay if Rudolph doesn't have that field at all:

my $record = {
&nbsp;type     =&gt; '//rec',
&nbsp;required =&gt; {
&nbsp;&nbsp;name       =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;start_date =&gt; { type =&gt; '//str' },
&nbsp;&nbsp;},
&nbsp;optional =&gt; {
&nbsp;&nbsp;aliases =&gt; {
&nbsp;&nbsp;&nbsp;type =&gt; '//arr',
&nbsp;&nbsp;&nbsp;contents =&gt; '//str'
&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;},
&nbsp;};

Now both files validate:

&nbsp;$ perl bin/validate data/rudolph.json data/donner.json
&nbsp;Checking data/donner.json
&nbsp;Checking data/rudolph.json

Custom types

Santa still has a problem because the date formats in his two test records don't match. The values are both strings, but that's it. Donner has 1823-12-24 but Rudolph has 12/24/1939.

Santa defines a new package that inherits from Data::Rx::CommonType::EasyNew. This package defines type_uri, which is the name for the new type, and assert_valid, which is the Perl subroutine that calls fail with the parts that Data::Rx needs to report the error:

package Reindeer::YYYYMMDD {
&nbsp;use parent 'Data::Rx::CommonType::EasyNew';

&nbsp;sub type_uri {
&nbsp;&nbsp;'tag:example.com,EXAMPLE:rx/reindeer-date',
&nbsp;&nbsp;}

&nbsp;sub assert_valid {
&nbsp;&nbsp;my ($self, $value) = @_;
&nbsp;&nbsp;return 1 unless defined $value;
&nbsp;&nbsp;$value =~ /\A(?:\d\d\d\d)-\d\d-\d\d\z/a or $self-&gt;fail({
&nbsp;&nbsp;&nbsp;error =&gt; [ qw(type) ],
&nbsp;&nbsp;&nbsp;message =&gt; &quot;date value is not YYYY-MM-DD&quot;,
&nbsp;&nbsp;&nbsp;value =&gt; $value,
&nbsp;&nbsp;&nbsp;})
&nbsp;&nbsp;}
&nbsp;}

(You can put this in a separate file and load it with use, or stick it right in the current program.)

To use this new type, Santa loads it as part of the call to new:

my $rx = Data::Rx-&gt;new({
&nbsp;&nbsp;type_plugins =&gt; [qw(
&nbsp;Reindeer::YYYYMMDD
&nbsp;&nbsp;)],	});

Now Santa's program catches the date format error:

&nbsp;$ perl bin/validate data/rudolph.json data/donner.json
&nbsp;Checking data/donner.json
&nbsp;Checking data/rudolph.json
&nbsp;&nbsp;Failed tag:example.com,EXAMPLE:rx/reindeer-date: date value is not YYYY-MM-DD (error: type at $data-&gt;{start_date})

Santa didn't have to change anything in the meat of his program. Everything in the foreach loop stayed the same and he only has the change his Rx specification. Whoever invented Rx and Data::Rx are quickly moving to the top of his Nice list (and that would be the double nice Rik SIGNES).

I write about this sort of thing quite a bit in Effective Perl Programming and Mastering Perl. Moving things out of logic and into configuration makes the program easier to modify and the data easier to understand.

The schema as configuration

Since Santa's Data::Rx schema is really a data structure, anything that can create that data structure can be its source. For example, Santa could put it in a YAML file (if you'd rather have JSON, you can do that instead):

&nbsp;---
&nbsp;type: '//rec'
&nbsp;required:
&nbsp;&nbsp;name:
&nbsp;&nbsp;&nbsp;type: '//str'
&nbsp;&nbsp;start_date:
&nbsp;&nbsp;&nbsp;type: 'tag:example.com,EXAMPLE:rx/reindeer-date'
&nbsp;optional:
&nbsp;&nbsp;aliases:
&nbsp;&nbsp;&nbsp;type: '//arr'
&nbsp;&nbsp;&nbsp;contents: '//str'

In Santa's program, he loads his schema with the YAML module instead of defining it as code. The rest of the program stays the same:

use YAML;

my $record = YAML::LoadFile( 'rx.yml' );

By having the schema outside of the Perl source, Santa can reuse it with other tools. So far, Rx has only very limited support for custom types, so those parts still have to live in code.

See Data::Rx in action

I used a very simple example to give you the flavor of Rx, but I'm using this on actual data structures for CPAN Security Advisories. Each reported CPAN distribution has a file dedicated to it, and there are certain pieces of information we want to collect for each distribution and for each advisory in that distribution. Some of that is hand-edited, which inevitably leads to mistakes.

Adding Data::Rx tests, as in xt/validate.t and xt/validate-db.t, allows us to check every data file for structure, format, and values.

In those tests you'll see more of Rx's core types, more custom types, and more complicated structures.

GitHub Actions: A Festive Tale of DevOps Magic

2024-12-04T00:00:00Z

It was a crisp December morning at the North Pole, and Pixie the Elf (whose parents had weird ideas about names) was already hard at work in Santa’s Workshop. Her job was critical: maintaining Santa’s Good/Bad Child Tracking App, affectionately nicknamed "NaughtyOrNice". The app, a sprawling Perl application, kept records on every child’s behaviour throughout the year. But as Christmas drew nearer, the workload multiplied, and Pixie was feeling the strain.

The Problem: Manual Testing Mayhem

For years, Pixie had been managing NaughtyOrNice with a mix of manual testing, haphazard deployment scripts, and a good deal of holiday cheer. But this year, the app had grown exponentially, with new features like integration with Smart Chimney Sensors™ and support for multi-timezone sleigh operations.

Every code change required hours of testing—on Pixie's local machine, of course—followed by an error-prone manual deployment process. One too many late-night debugging sessions left Pixie wondering if she was on Santa's Naughty list herself.

"I need help," she muttered to herself during one particularly long debugging session. She decided to take a break, grabbed a coffee from the machine and started idly browsing r/elftech. Immediately, an article about GitHub Actions caught her attention.

What Are GitHub Actions?

Pixie had vaguely heard of GitHub Actions before, but she’d always assumed it was for the tech-savvy elves in charge of JavaScript or Rust projects. The article made it seem that GitHub Actions were just as useful for Perl developers, and that it could automate much of her workflow.

Intrigued, Pixie decided to dive in.

A First Workflow: Automating Tests

Pixie started with the basics: automating the test suite for NaughtyOrNice. The app already had a robust set of tests written with Test::More , but running them manually was tedious.

Pixie created her first GitHub Actions workflow file, .github/workflows/test.yml:

name: Perl Test Suite

on:
&nbsp;&nbsp;push:
&nbsp;&nbsp;&nbsp;&nbsp;branches:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- main
&nbsp;&nbsp;pull_request:

jobs:
&nbsp;&nbsp;test:
&nbsp;&nbsp;&nbsp;&nbsp;runs-on: ubuntu-latest

&nbsp;&nbsp;&nbsp;&nbsp;steps:
&nbsp;&nbsp;&nbsp;&nbsp;- name: Checkout code
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;uses: actions/checkout@v4

&nbsp;&nbsp;&nbsp;&nbsp;- name: Set up Perl
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;uses: shogo82148/actions-setup-perl@v1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;with:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl-version: '5.40'

&nbsp;&nbsp;&nbsp;&nbsp;- name: Install dependencies
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;run: cpanm --quiet --installdeps .

&nbsp;&nbsp;&nbsp;&nbsp;- name: Run tests
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;run: prove -lr t/

Pixie was impressed. With just a few lines of YAML, she could trigger her tests automatically whenever someone pushed code to the main branch or opened a pull request. No more manual testing! She could focus on writing code instead of running it.

Adding Deployment: Automating the NaughtyOrNice Rollout

With her test suite humming along, Pixie turned her attention to deployments. Previously, deploying the app involved copying files to the production server with a combination of scp commands and festive hope.

She created another workflow file, .github/workflows/deploy.yml:

name: Deploy to Production

on:
&nbsp;&nbsp;workflow_dispatch:

jobs:
&nbsp;&nbsp;deploy:
&nbsp;&nbsp;&nbsp;&nbsp;runs-on: ubuntu-latest

&nbsp;&nbsp;&nbsp;&nbsp;steps:
&nbsp;&nbsp;&nbsp;&nbsp;- name: Checkout code
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;uses: actions/checkout@v4

&nbsp;&nbsp;&nbsp;&nbsp;- name: Deploy to server
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;env:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;RSYNC_PASSWORD: ${{ secrets.RSYNC_PASSWORD }}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;run: |
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;rsync -avz --delete ./ naughtyornice@production-server:/var/www/naughtyornice/

By adding a secret to the GitHub repository for her server credentials, Pixie automated the entire deployment process. The workflow_dispatch key in the on section of the workflow added a "Run" button to the "Actions" tab in the GitHub repo, and just pressing that would deploy the application to the production server. No more late nights. No more missed sleigh rides. Pixie even dared to start dreaming about creating a Docker container for NaughtyOrNice and deploying the application that way. The time she would save would allow her to look into long-awaited improvements like that.

The Real Magic: Pre-Written Workflows

Pixie was excited. This was going to make her life much better in so many ways, And then she remembered the main point of the article she had been reading. A group of Perl programmers on GitHub had created a set of reusable workflows. They were aimed at CPAN modules, but as the NaughtyOrNice codebase followed all of the CPAN packaging conventions, she thought she could probably use these workflows for her code.

Pixie read the instructions for using these workflows (they were online at https://github.com/PerltoolsTeam/github_workflows/) and, in a few minutes, she had a new workflow which looked like this:

name: CI

on:
&nbsp;&nbsp;push:
&nbsp;&nbsp;&nbsp;&nbsp;branches: [ main ]
&nbsp;&nbsp;pull_request:
&nbsp;&nbsp;&nbsp;&nbsp;branches: [ main ]
&nbsp;&nbsp;workflow_dispatch:

jobs:
&nbsp;&nbsp;test:
&nbsp;&nbsp;&nbsp;&nbsp;uses: PerlToolsTeam/github_workflows/.github/workflows/cpan-test.yml@main

&nbsp;&nbsp;coverage:
&nbsp;&nbsp;&nbsp;&nbsp;uses: PerlToolsTeam/github_workflows/.github/workflows/cpan-coverage.yml@main

&nbsp;&nbsp;perlcritic:
&nbsp;&nbsp;&nbsp;&nbsp;uses: PerlToolsTeam/github_workflows/.github/workflows/cpan-perlcritic.yml@main

&nbsp;&nbsp;complexity:
&nbsp;&nbsp;&nbsp;&nbsp;uses: PerlToolsTeam/github_workflows/.github/workflows/cpan-complexity.yml@main

Pixie was very happy. In a few lines of code, she had replaced and improved on her existing manual processes. The application was now being tested automatically on several versions of Perl and on Linux, Windows and macOS. She was also getting test coverage reports on Coveralls.io. But the things she was most excited by were the PerlCritic and Cyclomatic Complexity reports. Both of these gave her a huge number of ideas for improvements to the code. And now that the process was so much more efficient, she might actually have time to implement some of them. Happily, she started adding the suggestions into the NaughtyOrNice issue tracker.

The Result: A Smoother Christmas

On Christmas Eve, as Santa prepared for his big journey, he stopped by Pixie's workstation.

"Pixie," Santa said with a twinkle in his eye, "thanks to your hard work, this year the app is the best it's ever been. You’ve truly outdone yourself."

Pixie blushed. "It wasn’t just me, Santa. I had help—from GitHub Actions!"

Your Own Holiday Automation

Pixie's story shows that even the busiest developers can save time and reduce stress with GitHub Actions. Whether you're maintaining a legacy Perl app or building a shiny new one, these workflows can simplify your life.

To get started, check out the pre-written workflows at https://github.com/PerltoolsTeam/github_workflows/. Who knows? They might just bring a little magic to your own development process.

Happy holidays, and happy automating!

Sleigh Bells and Custom Ops: A Jolly Journey with Ref::Util

2024-12-03T00:00:00Z

Ho ho ho! 🎅 As the festive season wraps us in its warm embrace, let's unwrap a shiny gift for Perl developers that's been nestled under the tree for a few years now: Ref::Util. Just like how some of the best presents are hidden in plain sight, Ref::Util brings a sprinkle of efficiency and clarity to our code, turning "naughty" reference checks into "nice" ones. So grab a mug of hot cocoa, and let's dive into this yuletide tale!

A Christmas Classic Worth Revisiting

If Ref::Util sounds familiar, it might be thanks to the Perl Advent Calendar from 2016, where it was first introduced as a way to reduce common errors in ref-checking and boost performance with custom ops. However, many Perl newcomers and those who missed the original may not yet know about this handy tool. Let’s revisit this modern Christmas classic and explore how Ref::Util can make your Perl code cleaner, faster, and more robust.

The Ghost of Reference Checks Past 🎁

In the days of yore, you might have found yourself writing code like:

if ( ref $sleigh eq 'HASH' ) {
&nbsp;&nbsp;&nbsp;&nbsp;load_presents($sleigh);
}

But alas! This is like finding coal in your stocking. 🎄 By using ref $sleigh eq 'HASH', we're peeking behind the curtains, exposing Perl's internal workings. We're grabbing the string representation of a reference and hoping it matches our expectations. If $sleigh isn't a reference at all, ref returns an empty string — leaving us out in the cold. (At least it's not undef, which would likely wreak havoc during runtime).

Unwrapping Ref::Util ✨

Enter Ref::Util, our festive hero that's been around for a while but might not have made it onto your wish list yet! With it, we can rewrite our code as:

use Ref::Util qw&lt; is_hashref &gt;;

if ( is_hashref($sleigh) ) {
&nbsp;&nbsp;&nbsp;&nbsp;load_presents($sleigh);
}

Isn't that as refreshing as a winter's first snow? ❄️ The code is cleaner and more readable, but the true magic lies beneath the surface. Ref::Util doesn't just sprinkle a bit of tinsel on your code — it supercharges it! Ref::Util even provides a sleigh full of functions to check all sorts of references:

is_ref($variable)
is_scalarref($variable)
is_arrayref($variable)
is_hashref($variable)
is_coderef($variable)
is_regexpref($variable)
is_globref($variable)
is_formatref($variable)
is_ioref($variable)
is_refref($variable)

And their is_plain_* and is_blessed_* counterparts.

This comprehensive suite lets you check for any type of reference without exposing Perl's internals, making your code more robust and intention-revealing.

Example:

use Ref::Util qw&lt; is_blessed_arrayref &gt;;

if ( is_blessed_arrayref($elves) ) {
&nbsp;&nbsp;&nbsp;&nbsp;assign_tasks($elves);
}

Instead of:

use Scalar::Util qw&lt; blessed reftype &gt;;
if ( ref_type($elves) eq 'ARRAY' &amp;&amp; blessed($elves) ) {
&nbsp;&nbsp;&nbsp;&nbsp;assign_tasks($elves);
}

(You might consider calling blessed($elves) eq 'ARRAY' but that doesn't differentiate between package name and reference type.)

Performance: The Gift That Keeps on Giving 🎁

Now, you might be thinking, "Sure, the code looks nicer, but is that all?" Oh, dear reader, the true magic lies in the massive speed improvements! Ref::Util doesn't just make your code more readable — it makes it faster.

Let's peek into Santa's workshop and look at some benchmarks:

    Ref::Util::is_plain_arrayref (CustomOP):  2.7951 +/- 0.0062 (0.2%) -- baseline
    ref():                                    5.3350 +/- 0.0180 (0.3%) -- 1.90 times
    Data::Util::is_array_ref:                 5.9074 +/- 0.0075 (0.1%) -- 2.11 times
    ref(), reftype(), !blessed():            15.5450 +/- 0.0310 (0.2%) -- 5.56 times

As you can see, Ref::Util::is_plain_arrayref using Custom Ops is nearly twice as fast as ref() (2.7951 vs. 5.335 seconds) and more than five times faster than combining ref(), Scalar::Util::reftype(), and blessed() checks (2.7951 vs. 15.545 seconds). It's like upgrading from a hand-drawn sleigh to a rocket-powered one! 🚀

Elves Under the Hood: The Magic of Op Codes 🧙&zwj;♀️

So, how does Ref::Util achieve this festive feat? It's all thanks to some Christmas magic called Custom Ops, introduced in Perl 5.14 (released in 2011). Let's unwrap this concept together.

What Are Op Codes and the Optree?

In Perl, your code gets compiled into a tree of operations called the optree. Each operation (op) represents a fundamental action, like addition, subtraction, or fetching a variable. Think of it as the assembly instructions for Santa's elves.

The Traditional Method's Optree

Let's take the following one-liner:

    perl -MO=Concise -e&#39;if ( ref $sleigh eq &quot;HASH&quot; ) {1}&#39;

We can see the following optree, which is printed out by B::Concise when loaded with -MO=Concise:

    7  &lt;@&gt; leave[1 ref] vKP/REFC -&gt;(end)
    1     &lt;0&gt; enter v -&gt;2
    2     &lt;;&gt; nextstate(main 1 -e:1) v:{ -&gt;3
    -     &lt;1&gt; null vK/1 -&gt;7
    6        &lt;|&gt; and(other-&gt;7) vK/1 -&gt;7
    5           &lt;2&gt; seq sK/2 -&gt;6
    -              &lt;1&gt; ex-rv2sv sK/1 -&gt;4
    3                 &lt;#&gt; gvsv[*sleigh] s -&gt;4
    4              &lt;$&gt; const[PV &quot;HASH&quot;] s -&gt;5
    -           &lt;@&gt; scope vK -&gt;7
    -              &lt;;&gt; ex-nextstate(main 3 -e:1) v -&gt;-
    -              &lt;0&gt; ex-const v -&gt;-

This involves multiple ops: fetching the variable, getting its reference type as a string, and then comparing that string.

Scalar::Util's `reftype` Optree

Using Scalar::Util's reftype, the following code:

    perl -MO=Concise -MScalar::Util=reftype -e&#39;if ( reftype($sleigh) eq &quot;HASH&quot; ) {1}&#39;

We get the following optree:

    a  &lt;@&gt; leave[1 ref] vKP/REFC -&gt;(end)
    1     &lt;0&gt; enter v -&gt;2
    2     &lt;;&gt; nextstate(main 49 -e:1) v:{ -&gt;3
    -     &lt;1&gt; null vKP/1 -&gt;a
    9        &lt;|&gt; and(other-&gt;a) vK/1 -&gt;a
    8           &lt;2&gt; seq sK/2 -&gt;9
    6              &lt;1&gt; entersub[t1] sKS/TARG -&gt;7
    -                 &lt;1&gt; ex-list sK -&gt;6
    3                    &lt;0&gt; pushmark s -&gt;4
    -                    &lt;1&gt; ex-rv2sv sKM/1 -&gt;5
    4                       &lt;#&gt; gvsv[*sleight] s -&gt;5
    -                    &lt;1&gt; ex-rv2cv sK/1 -&gt;-
    5                       &lt;#&gt; gv[*reftype] s -&gt;6
    7              &lt;$&gt; const[PV &quot;HASH&quot;] s -&gt;8
    -           &lt;@&gt; scope vK -&gt;a
    -              &lt;;&gt; ex-nextstate(main 51 -e:1) v -&gt;-
    -              &lt;0&gt; ex-const v -&gt;-

This involves more ops due to the subroutine call to reftype, adding overhead. Also, notice pushmark which adds additional variables to the stack, adding variables to the function stack that could be retrieved by calling shift. (You read this right - even having parameters to a function includes another opcode.)

Ref::Util with Custom Ops

With Ref::Util on Perl 5.14 or newer, and when using a version of Ref::Util that supports Custom Ops, let's write the following code:

    perl -MO=Concise -MRef::Util=is_hashref -e&#39;if ( is_hashref($sleight) ) {1}&#39;

We get the following optree:

    6  &lt;@&gt; leave[1 ref] vKP/REFC -&gt;(end)
    1     &lt;0&gt; enter v -&gt;2
    2     &lt;;&gt; nextstate(main 73 -e:1) v:{ -&gt;3
    -     &lt;1&gt; null vKP/1 -&gt;6
    5        &lt;|&gt; and(other-&gt;6) vK/1 -&gt;6
    4           &lt;1&gt; is_hashref sK/1 -&gt;5
    -              &lt;1&gt; ex-rv2sv sKM/1 -&gt;4
    3                 &lt;#&gt; gvsv[*sleight] s -&gt;4
    -           &lt;@&gt; scope vK -&gt;6
    -              &lt;;&gt; ex-nextstate(main 75 -e:1) v -&gt;-
    -              &lt;0&gt; ex-const v -&gt;-

Notice how is_hashref becomes its own op in the optree, named is_hashref. This Custom Op directly checks the reference type at the opcode level, eliminating unnecessary steps.

How Does This Magic Happen?

Custom Ops Implementation (Fastest) 🎅

When available, Ref::Util uses Custom Ops written in C (using XS). These are new operations added directly into Perl's optree, resulting in minimal overhead and maximal speed. It's like giving the elves new, more efficient tools.
XS Implementation (Fast) 🦌

If Custom Ops aren't available (due to an older Perl version or limitations in the environment), Ref::Util gracefully falls back to an XS implementation without Custom Ops. This means the functions are still written in C for performance but are called as regular functions. It's still faster than pure Perl but not as swift as using Custom Ops.
Pure-Perl Implementation 🛷

When neither Custom Ops nor XS implementations are available (such as on systems without a C compiler), Ref::Util provides a pure-Perl fallback. This version has similar performance to the traditional method but retains the benefits of cleaner syntax and abstraction.

The Spirit of the Season: Cleaner and Faster Code 🎅

Beyond performance, Ref::Util embodies the true spirit of the holidays — making things better for everyone. By using functions like is_hashref, is_arrayref, is_coderef, et. al., our code becomes more expressive, intention-revealing, and helps catch typos in reference checks. It's easier for others (and future you) to read and understand, reducing those "bah humbug" moments during code reviews.

When Feeling Grateful 🙏

There are plenty of people who worked hard to make Ref::Util possible, and they deserve a lot of credit:

Vikenty Fesunov
Aaron Crane
Gonzalo Diethelm
Karen Etheridge
Yves Orton
Steffen Müller
Jarkko Hietaniemi
Mattia Barbon
Zefram
Tony Cook
Sergey Aleynikov

A New Year's Resolution 🥂

As we bid farewell to the old year and welcome the new, let's make a resolution to write cleaner, faster, and more maintainable Perl code. Ref::Util is a wonderful tool to help us on that journey.

So, next time you find yourself writing ref $variable eq 'TYPE', remember there's a merrier way. Let Ref::Util spread joy in your codebase, and may your days be merry and bright!

Happy Holidays and Happy Coding!

May your CPU cycles be short and your code delights be plenty! 🎉

A Trio of Modules to Speed Up Your Web Applications!

2024-12-02T00:00:00Z

It is the season of giving, and Perl has a few special packages waiting under the tree that can give your web applications a little extra pep in their step. This holiday, let's celebrate three modules that make web development smoother and faster: HTTP::XSHeaders, HTTP::XSCookies, and URI::XSEscape. These tools are like those little surprises that make everything run just a bit better, a bit faster — without you lifting a finger. Let's unwrap their magic and see how they bring a new level of efficiency to Perl web applications!

HTTP::XSHeaders and URI::XSEscape: Sleigh-Speed for Your Framework

If you're using a web framework built on Perl, chances are it relies on HTTP::Headers and URI::Escape under the hood. These modules are hard workers, responsible for parsing HTTP headers and handling URL encoding, respectively, but they are not the quickest reindeer in the race. Luckily, here come HTTP::XSHeaders and URI::XSEscape — both designed to give your application a boost.

When your code loads HTTP::XSHeaders or URI::XSEscape, they automatically override HTTP::Headers (even its faster variant, HTTP::Headers::Fast) and URI::Escape, making your web framework faster without a single line of modification.

Even better, if you are using the Dancer2 framework, it will automatically detect and load HTTP::XSHeaders and URI::XSEscape if they are available, boosting performance without any extra setup. It is like a holiday bonus for your application, giving it speed improvements without any added work!

HTTP::XSCookies: A Sweet Swap for Framework Developers

For developers building web frameworks, there is another gift waiting for you: HTTP::XSCookies. This module serves as a high-speed replacement for HTTP::Cookies, designed to speed up cookie handling without the need for reindeer-powered sleighs. Unlike the other two modules, HTTP::XSCookies doesn’t override the original module. So, if you want your application to take advantage of its speed, you will need to replace HTTP::Cookies with HTTP::XSCookies directly in your codebase.

However, if you are using the Dancer2 framework, it will automatically use HTTP::XSCookies if it is installed, allowing your code to benefit from its performance boost seamlessly.

Deck the Code with Speed

These modules aren’t just gifts for your application — they are here to spread holiday cheer to your users too. By loading just a few lines of code, you will be spreading joy in the form of faster response times and more efficient performance. Whether you are a user or a developer, these modules are like holiday magic for your Perl-based web applications.

Wishing You a Snappy and Speedy New Year!

So this holiday season, consider giving your web application the gift of speed. With HTTP::XSHeaders, HTTP::XSCookies, and URI::XSEscape in your toolkit, you are set for a snappier, speedier new year. Here is to faster code, happy users, and a fantastic Perl-powered holiday!

While You're Waiting for Corinna

2024-12-01T00:00:00Z

Introduction

It's getting close to that time of year and you've been a good little child and are eagerly awaiting Corinna, which Santa has promised to deliver, fully-assembled, by Christmas.

Alas, Santa is also a Perl developer and following the Perl tradition, he's been a bit coy about which Christmas. Worse, your coworkers freak out at the idea of using the lovely Object::Pad module and, in any event, you're stuck on an older version of Perl, meaning you couldn't use Corinna even if it was Christmas.

You'd like something a touch more robust and modern than Moo/se, but what can you do? Let's look in Santa's Bag and see what we can find.

Santas::Bag

Turns out that when Santa's rummaging around in his bag, there are some toys he delivers more than others. He's realized that an LRU cache is perfect for this. Let's take a peek inside.

package Santas::Bag;
use My::Moose types =&gt; [qw/InstanceOf PositiveOrZeroInt/];
use Hash::Ordered;

param max_size =&gt; (    # allowed in constructor
&nbsp;&nbsp;&nbsp;&nbsp;isa     =&gt; PositiveOrZeroInt,
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; 20,
&nbsp;&nbsp;&nbsp;&nbsp;writer  =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;trigger =&gt; method( $max_size, $old_max_size = 20 )
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return if $max_size &gt; $old_max_size;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_constrain_cache_size;
&nbsp;&nbsp;&nbsp;&nbsp;},
);

field _cache =&gt; (     # forbidden in constructor
&nbsp;&nbsp;&nbsp;&nbsp;is      =&gt; 'rwp',
&nbsp;&nbsp;&nbsp;&nbsp;isa     =&gt; InstanceOf ['Hash::Ordered'],
&nbsp;&nbsp;&nbsp;&nbsp;default =&gt; sub { Hash::Ordered-&gt;new },
&nbsp;&nbsp;&nbsp;&nbsp;handles =&gt; [qw/keys/],
);

method _constrain_cache_size() {
&nbsp;&nbsp;&nbsp;&nbsp;my $max_size = $self-&gt;max_size;
&nbsp;&nbsp;&nbsp;&nbsp;if ( !$max_size ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_set__cache( Hash::Ordered-&gt;new );
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $cache = $self-&gt;_cache;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$cache-&gt;pop while $cache-&gt;keys &gt; $max_size;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

method set( $key, $value ) {
&nbsp;&nbsp;&nbsp;&nbsp;return unless $self-&gt;max_size;
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_cache-&gt;unshift( $key, $value );
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_constrain_cache_size;
}

method get($key) {
&nbsp;&nbsp;&nbsp;&nbsp;return unless $self-&gt;_cache-&gt;exists($key);
&nbsp;&nbsp;&nbsp;&nbsp;my $value = $self-&gt;_cache-&gt;get($key);
&nbsp;&nbsp;&nbsp;&nbsp;$self-&gt;_cache-&gt;unshift( $key, $value );
&nbsp;&nbsp;&nbsp;&nbsp;return $value;
}

And then you burst into song!

    What&rsquo;s this? What&rsquo;s this?
    There&rsquo;s methods everywhere
    What&rsquo;s this?
    There&rsquo;s no immutability we&rsquo;ve declared
    What&rsquo;s this?
    I can&rsquo;t believe my eyes
    I must be dreaming. Wake up, Jack! This isn&rsquo;t Moose! What&rsquo;s this?

What is this? It looks kind of like Moose, but we have actual methods? There's no need to declare $self? Why isn't it declared as immutable? And where's the trailing true value at the end? And it looks like Type::Tiny is built in? What is going on?

Well, an LRU cache is perfect when you have an unequal distribution of toys. Rubik's Cubes, for example, are not quite as popular as trains or dolls, so when Santa reaches into his bag, he wants to be able to quickly find the most popular toys. Any time you add a toy to the bag, or fetch a toy from the bag, it becomes the "most recently used" toy; the "least recently used" toy is evicted from the cache.

Santa wants Christmas to go smoothly, so he started to write some tests.

use Test2::V0;

my @presents = qw(
&nbsp;&nbsp;Lego         Barbie      Doll
&nbsp;&nbsp;PlayStation5 XboxSeriesX TeddyBear
&nbsp;&nbsp;Bicycle      TrainSet    Socks
);

my $santas_bag = Santas::Bag-&gt;new( max_size =&gt; 5 );
$santas_bag-&gt;set( $_, $presents[ $_ - 1 ] ) for 1 .. 10;
is $santas_bag-&gt;max_size, 5, 'The max_size attribute is 5';
my @keys = $santas_bag-&gt;keys;
is \@keys, [10,9,8,7,6], '... and the key order is by most recently added';
is $santas_bag-&gt;get(9), 'Socks', 'We get the value for key 9';
@keys = $santas_bag-&gt;keys;
is \@keys, [9, 10, 8,7,6], '... and the key order is still by most recently added';
$santas_bag-&gt;set_max_size(3);
is scalar $santas_bag-&gt;keys, 3,
&nbsp;&nbsp;'The cache now has 3 entries after we call set_max_size(3)';
@keys = $santas_bag-&gt;keys;
is \@keys, [9, 10, 8], '... and the key order is still preserved';
is $santas_bag-&gt;get(9), 'Socks',    'We still get the value for key 9';
is $santas_bag-&gt;get(8), 'TrainSet', 'We get the value for key 8';
is $santas_bag-&gt;get(7), undef,      'We get undef for key 7';

done_testing();

After reading his code, and checking it twice, Santa runs those tests.

        ok 1 - The max_size attribute is 5
        ok 2 - ... and the key order is by most recently added
        ok 3 - We get the value for key 9
        ok 4 - ... and the key order is still by most recently added
        ok 5 - The cache now has 3 entries after we call set_max_size(3)
        ok 6 - The key order is preserved, but we only have three entries
        ok 7 - We still get the value for key 9
        ok 8 - We get the value for key 8
        ok 9 - We get undef for key 7
        1..9

OK, that's looking pretty good. But how did we get all of that lovely, modern goodness, via the My::Moose module? It uses the magic of MooseX::Extended, a module that takes what we've learned from the design of Corinna and tries to apply as much of that to Moose as is feasible.

package My::Moose;

use MooseX::Extended::Custom;
use PerlX::Maybe 'provided';

# If $^P is true, we're running under the debugger.
#
# When running under the debugger, we disable __PACKAGE__-&gt;meta-&gt;make_immutable
# because the way the debugger works with B::Hooks::AtRuntime will cause
# the class to be made immutable before the we apply everything we need. This
# causes the code to die.
sub import ( $class, %args ) {
&nbsp;&nbsp;&nbsp;&nbsp;MooseX::Extended::Custom-&gt;create(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;includes               =&gt; [qw/method/],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;provided $^P, excludes =&gt; 'immutable',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;%args    # you need this to allow customization of your customization
&nbsp;&nbsp;&nbsp;&nbsp;);
}

That's it! That's all you have to do to get a fairly modern, clean version of Moose that works all the way back to Perl v5.20.0, released way back in 2014.

But what's going on? Well, as it turns out, Santa has a temper and when he sees boilerplate, he sees red. You've been a naughty little child. Boilerplate is bad. In the above, My::Moose is equivalent to writing the following boilerplate for all of your Moose classes (plus a few extra things, such as the param and field functions).

package My::Class;
use v5.20.0;
use Moose;
use MooseX::StrictConstructor;
use feature qw( signatures postderef postderef_qq );
no warnings qw( experimental::signatures experimental::postderef );
use namespace::autoclean;
use Carp;
use mro 'c3';
use Function::Parameters;

# your code here

__PACKAGE__-&gt;meta-&gt;make_immutable;
1;

Are you really going to add that to all of your modules? Are you going to copy-n-paste? Are you going to remember everything if you do it manually? Are you going to globally go through and change it manually if you need to adjust something?

Of course, that doesn't mean Santa's defaults are going be your defaults. For example, some people don't like MooseX::StrictConstructor, so just omit it. Some people want try/catch, so include it.

sub import ( $class, %args ) {
&nbsp;&nbsp;&nbsp;&nbsp;my @excludes = qw(StrictConstructor);
&nbsp;&nbsp;&nbsp;&nbsp;push @excludes, 'immutable' if $^P; # running under the debugger
&nbsp;&nbsp;&nbsp;&nbsp;MooseX::Extended::Custom-&gt;create(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;includes =&gt; [qw/method try/],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;excludes =&gt; \@excludes,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;%args    # you need this to allow customization of your customization
&nbsp;&nbsp;&nbsp;&nbsp;);
}

If you're already using Moose, you can read about Migrating from Moose to see if this works for you (that link goes to the tutorial). And assuming you use roles, you can customize those, too.

Perl Advent Calendar 2024

Merry Christmas, bless us, everyone

Perl 5

The Legacy of Perl

The Advent Calendar Itself

A Merry Christmas to us all; Bless us, everyone

A New Logo for Perl

The Backstory (2020)

The Perl Toolchain Summit (2024)

The License

Who Put You in Charge?

What About The Perl and Raku Foundation?

Where Can I Get a Copy of the Logo?

Where Can I Give Feedback?

Are There Other Options?

Who Owns this Logo?

What&#39;s Next?

use VERSION

A yearly non-December gift

What&#39;s in the box? New features!

The gift of choice

use VERSION

Enforce running with a minimum version of the perl binary

Load the corresponding feature bundle

Enable modern Perl features

Deprecate discouraged features

Why pick a Perl version?

Line 0 semantics

Line 1 semantics

Declaring a baseline of the Perl language

The Once and Future Perl

The new &quot;use strict and warnings&quot;

Picking which version of Perl to code in

Updating your Perl code at your own pace

Updating your Perl code faster

That Time Perl+OpenMP Saved Christmas

&quot;Investigating a new respiratory virus outbreak in Santa&#39;s workshop&quot;

Using the Awesome Power of Perl in Bioinformatics

Our Script that Creates a Lookup Table, and then Swaps Coordinates in a bed File

Conclusion

Half My Life with Perl

Santa will be watching

Integrating with Mojolicious

Integrating with Dancer2

From the terminal to the browser

Annotating Christmas Trees

Lesser-known businesses

There&rsquo;s trees and there&rsquo;s trees

Diving deeper

No happy ending?

Merry Inline C(hristmas)

Dancing through the Cnow

To A or not to A?

Regex for noisy A&#39;s

Inline::C for performance

Making memories this C(hristmas)

Conclusions

Perl, my child, is love in Github Actions

Let&#39;s talk a bit about GitHub Actions

But there&#39;s a lot of boilerplate

Using Valiant for Validations in Agendum: A Deep Dive into DBIx::Class Integration

Valiant Overview (in a nutshell)

The Demo Database Model

The Validations

Valiant and DBIx::Class

Using the Validations

Conclusion

Production monitoring

Meeting the Quota

Monitoring

Server Configuration

Server

Running the Server

Design Decisions

Central Client

Incrementing the Counter

Final Thoughts

Stay focused and organised during the advent season

Toys warehouse and drones

Agile at the Toys warehouse

What's Next?

What's in the box? New features!

`use VERSION`

The new "use strict and warnings"

"Investigating a new respiratory virus outbreak in Santa's workshop"

There’s trees and there’s trees

Regex for noisy A's

Let's talk a bit about GitHub Actions

But there's a lot of boilerplate

The first day's play: Let's get started

So what's inside the map? Peek behind the curtain

Let's Make Selenium Testing Less Painful Again

Pixie the Elf Picks an Artist: Exploring Perl's new class syntax

How `pickanartist` works

Santa's Work is Done

Santa's Naughty and Nice Data Formats

Santa's Naughty and Nice Data Formats