Perl Advent Calendar 2023

24 Years of the Perl Advent Calendar

2023-12-25T00:00:00Z

The Journey

It's Christmas Day, marking the end of year 24 of the Perl Advent Calendar. Is there another programming Advent Calendar with a longer history? I don't know and, to be honest, I haven't checked, but this feels like an impressive accomplishment and a good time to take a look back on this monumental project.

The archives begin in the year 2000. In those days, an Advent article was literally the documentation for a Perl module, beginning with Data::Dumper on Dec 1 and ending with Date::Christmas on the 25th. As an aside, Date::Christmas had its last release on Dec 3, 2000 and it still works.

$ cpm install -g Date::Christmas
$ perl -MDate::Christmas -le 'print christmasday (2023)'
Monday

If you're interested in the history of this project and how Mark Fowler came up with it, I encourage you to read the notes in the FAQ

The Stats

When I got involved in this project last year, I had just assumed that the calendar in its current format was much how it began, but that's not really true. The layout and the URLs have evolved over time and there have been varying levels of activity. Let's write a quick bash script to figure out some statistics.

    #!/usr/bin/env bash

    set -eu -o pipefail

    for year in $(seq 2000 2010); do
        found=$(find &quot;$year&quot; | grep -e &quot;/\d\d/index.html&quot; -c)
        echo &quot;$year $(printf &quot;%0.s&#x1F384;&quot; $(seq 1 &quot;$found&quot;))&quot;
    done

    for year in $(seq 2011 2023); do
        found=$(find &quot;$year/articles&quot; | grep -c pod$)
        echo &quot;$year $(printf &quot;%0.s&#x1F384;&quot; $(seq 1 &quot;$found&quot;))&quot;
    done

We get the following pretty graph:

    2000 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2001 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2002 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2003 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2004 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2005 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2006 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2007 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2008 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2009 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2010 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2011 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2012 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2013 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2014 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2015 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2016 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2017 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2018 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2019 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2020 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2021 &#x1F384;
    2022 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;
    2023 &#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;&#x1F384;

We can see that years 2000 to 2006 had 25 articles. The following 4 years don't quite make it to 25, but I would argue that the 24 articles in 2008 is genuinely "good enough". 2020 was sort of greatest hits repackaging of articles from earlier years and 2021 is an outlier. Last year we had so much momentum that we added a couple of extra articles and this year we are back to the usual pace.

The Evolution

As we noted above, the year 2000 was strictly Perl module documentation. The documentation angle may seem a bit weird, but back in 2000, CPAN wasn't all that old. Beginning in 2001, Mark wrote short blog posts about useful modules with his thoughts on them.

How about the delightful Christmas-themed posts? Well, the first mention of Santa is not until Dec 25, 2002. St. Nick does not seem to re-appear until Dec 10, 2006, the same year in which elves have their first mention.

In 2011 the calendar shifts from the layout which mimics a traditional advent calendar to one which looks more like a regular calendar. I'm guessing this is due to the emergence of WWW::AdventCalendar, which had its first release on Dec 25, 2009.

I should also note that over the 24 years of this project there have been many, many blog authors and editors. It has been an impressive group effort with real continuity.

Where are we Now?

In the intervening years, the Perl Advent Calendar has become a holiday tradition for many of us and something we look forward to. It's much more than just an interesting project, though. It's a snapshot of Perl as it is being used in the wild, a wonderful trip down memory lane and it documents the evolution of a genre: technical writing that leans on and extends the mythology of a collective Christmas traditions. Also, it's fun.

There is a real legacy to the calendar, though. I don't know how many of the authors imagined that decades later, their work would still be available for instructional reading and general enjoyment. Some of our personal blogs fade away as hosting disappears or even as we ourselves move on from this earth, but the calendar, after 24 years of service, documents the writings of Perl developers past and present.

If you're interested in becoming part of this history, we will accept articles throughout the year. The Call for Papers traditionally opens in the summer, but if you have a burning desire to write a blog post for the Advent Calendar, you can start right now and someone will be happy to help you along in the process.

A Big Thank You

For this year in particular, I'd like to thank everyone who helped out with the calendar. brian d foy, for kickstarting things in November when my mind was somewhere else. Also brian d foy for reviewing articles and contributing articles. On that note a large debt is owed to Pete Houston for reviewing many articles, with a number of those being on very short notice. I'd like to thank all of this year's authors and note that several of them contributed more than one article, which allowed us to make it to 25.

Lastly, I'd like to thank Mark Fowler for allowing us to continue on this great tradition.

A Big Anniversary

2024 will be year 25 of the Perl Advent Calandar. We should mark this in some way. How will we do it? We have a year to think about it.

In the meantime, please allow me to wish all of our editors, contributors and readers a "Happy Christmas to All and to All a Good Night".

Santa Kotlin is coming to Perl

2023-12-24T00:00:00Z

This post starts with a long introduction to explain why I'm writing, but if you want to skip all of that you can jump directly to the meat and potatoes.

Stay awhile and listen

I grew up as a Nintendo kid. Some of the first video games I played were on an NES, and the first console I ever owned was an SNES. I have very fond memories of those times and of the games I got to know and play.

Although at the time I don't think I considered applying that label to myself, it was very much a part of how I understood myself and my place among my peers. I was a Nintendo kid, and they... well, they were something else. Sega kids, maybe.

This misguided sense of identity paired well with a misguided sense of loyalty, which made it so I found it difficult to enjoy both at the same time. If I was a "Nintendo" kid, what would it mean if I enjoyed Sega... things? What would it mean to own one?

This was not only related to video games, either. I remember very easily falling into this trap with all sorts of similar "contrasts". I was a Beatles kid, so I couldn't like The Rolling Stones. I was a Star Wars kid, so I couldn't enjoy Star Trek. The list was tragically endless.

This was not so hard when my team was inarguably better than the other. But I remember how hard it got to be a "Nintendo kid" when the PlayStation came around. It was gritty, it was powerful, it was exciting... and it felt inaccessible.

Am I still reading the Perl advent calendar?

Ah, yes. Perl.

I've always loved Perl. It was not my very first programming language (you and me, BASIC, for life), but it was the first one where I felt like I could write real programs. The first that I felt was worth mastering, and the one I'm most comfortable with, even today.

So, surprise surprise, I was a Perl kid.

And there have been times when being a Perl kid has not been easy.

I am fortunately past the time when I look at the world in terms of clubs that you belong to because of the things you like. I will have you know I can listen to both Radiohead and Coldplay without breaking a sweat (I take no responsibility for deciding what contrasted with what).

But to this day, there are aspects of this worldview that remain in me.

Perl's PlayStation

I imagine this largely depends on my particular interests, but for the Perl kid in me, it was hard to see how easy the other kids had it when they wanted to integrate with other languages.

To me, this was the PlayStation to Perl's Nintendo.

I remember several attempts trying to teach my teenager-self how to write XS, so I could bind to this or that library. I remember feeling frustrated and defeated. I remember wondering if this meant that Perl was holding me back...

The answer is "no". If I was being held back, it was me who was doing so by again thinking in terms of clubs.

But even if I had continued to see the world through that lens, the Perl we have at our disposal today is miles from the Perl I learned as a kid. There are still, I am sure, plenty of areas where I think Perl has to catch up. But we are at a moment where Perl is positively blooming with new features and tools, that make catching up possible, if not outright easy.

In the last two versions alone (at the time of writing, 5.36 and 5.38) we have n-at-a-time iteration, a native try with finally support (finally!), the new defer blocks, native booleans, the new builtin namespace, and a powerful new syntax for defining classes. Not to mention other recent native features (like sub signatures and the isa operator), or the things made possible via CPAN: async/await support, the renewed efforts into PDL, and what I might consider the jewel of modern Perl: FFI::Platypus.

Time will tell, but I feel like this is what it must feel like to live during a renaissance.

Any chance of having actual code in this post?

Yes, I'm getting to that. Now that I've finished with the introduction we can get to the meat and potatoes of this post. I hope I didn't lose too many of you along the way.

Binding to Kotlin from Perl

What motivated this post in the first place was a task at work where I was asked to look into the feasibility of integrating with a third-party that provided SDKs for several languages... but not Perl.

Lucky for me, they had made the code of those SDKs publicly available, so I could examine it. And while looking through them I realised that most of the heavy lifting was done by binding to a shared C library. My teenager-self would have had a traumatic flashback sequence at this point, but this is modern Perl. We have FFI::Platypus. "This will be easy", I thought.

The challenge came when I realised that the library was originally written in Kotlin via what they know as "Kotlin/Native", which generates header files with some ad-hoc hoops for us to jump through. As an attempt at simplifying things, I've put together a repository with a sort of sample distribution that you can play around with as an illustration. The code examples below will be taken from it.

In any case, the native Kotlin extension will take code that looks like this:

package example

fun reverseString(str: String) : String {
&nbsp;&nbsp;&nbsp;&nbsp;return str.reversed()
}

and eventually wrap it in a C struct which will look like the one below:

typedef struct {
&nbsp;&nbsp;/* Service functions. */
&nbsp;&nbsp;// ... Snipped 28 fields with fields pointing to service functions

&nbsp;&nbsp;/* User functions. */
&nbsp;&nbsp;struct {
&nbsp;&nbsp;&nbsp;&nbsp;struct {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;struct {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;const char* (*reverseString)(const char* str);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} example;
&nbsp;&nbsp;&nbsp;&nbsp;} root;
&nbsp;&nbsp;} kotlin;
} libexample_ExportedSymbols;

extern libexample_ExportedSymbols* libexample_symbols(void);

Which, to summarise, is exposing a global libexample_symbols function which returns a pointer to a struct where the last field (named kotlin) holds a pointer to a struct with a field (named root) which holds a pointer to a struct with a field (named example) which holds a pointer to the function that you wrote.

That's a mouthful.

When I first saw this, and saw that doing it in eg. Ruby (the SDK I was looking at for guidance) was not only possible, but relatively simple-looking, I got pangs of that PlayStation feeling.

But as it turns out, FFI::Platypus already gives us all the tools to deal with something like this.

The first thing will be to define the nested structs, and for that we will need FFI::C (remember that you can look at the whole file these snippets are taken from in the sample repository):

package
&nbsp;&nbsp;&nbsp;&nbsp;Santa::Kotlin::Example {
&nbsp;&nbsp;&nbsp;&nbsp;FFI::C-&gt;struct( Example =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;reverseString =&gt; 'opaque',
&nbsp;&nbsp;&nbsp;&nbsp;]);
}

package
&nbsp;&nbsp;&nbsp;&nbsp;Santa::Kotlin::Root {
&nbsp;&nbsp;&nbsp;&nbsp;FFI::C-&gt;struct( Root =&gt; [ example =&gt; 'Example' ]);
}

package
&nbsp;&nbsp;&nbsp;&nbsp;Santa::Kotlin::Kotlin {
&nbsp;&nbsp;&nbsp;&nbsp;FFI::C-&gt;struct( Kotlin =&gt; [ root =&gt; 'Root' ]);
}

package
&nbsp;&nbsp;&nbsp;&nbsp;Santa::Kotlin::Symbols {

&nbsp;&nbsp;&nbsp;&nbsp;FFI::C-&gt;struct( Symbols =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# ... 28 skipped fields which we must have here too ...
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;kotlin =&gt; 'Kotlin',
&nbsp;&nbsp;&nbsp;&nbsp;]);
}

These packages are only for internal use, so that's why they have a newline after the package keyword: it makes it so that if this code is ever put on CPAN, these packages will not be indexed.

When defining a struct with FFI::C, the first parameter is a name that can be referred to later, which is why these are defined from the inside (the ones most deeply nested) going out. It means I can refer to the types of the inner fields when defining the outer structs, like in the root field of type Root in the struct for the Santa::Kotlin::Kotlin package: since it is of type Root, its value will automatically be cast into a Santa::Kotlin::Root object.

We still need to get our hands on an instance of this outermost struct, and for that we have to bind to that global libexample_symbols function:

# Register $ffi with FFI::C, so new types become available
FFI::C-&gt;ffi($ffi);

# ...

my $symbols = $ffi
&nbsp;&nbsp;&nbsp;&nbsp;-&gt;function( libexample_symbols =&gt; ['void'] =&gt; 'Symbols' )
&nbsp;&nbsp;&nbsp;&nbsp;-&gt;();

Since we've told FFI::C that it should register any types it creates with this instance of FFI::Platypus, we can use the Symbols type (which corresponds to the Santa::Kotlin::Symbols package defined above) as the return value of this function.

Note also that we are not attaching this function, because we are not going to expose it to our users. We only want to be able to call it once so we can get a reference to the struct it returns, which we store in $symbols.

Once we've done all this preparation, we are ready to attach any functions in our example Kotlin package to our Santa::Kotlin Perl package, and we do this by using the memory addresses of the functions we are interested in:

$ffi-&gt;attach(
&nbsp;&nbsp;&nbsp;&nbsp;#                  we look up the address    and give it a Perl name
&nbsp;&nbsp;&nbsp;&nbsp;#                                    \                 \
&nbsp;&nbsp;&nbsp;&nbsp;[ $symbols-&gt;kotlin-&gt;root-&gt;example-&gt;reverseString, 'reverse_string' ],
&nbsp;&nbsp;&nbsp;&nbsp;['string'] =&gt; 'string',
);

At this point, we are ready to call this function as we would any other from our perl code:

use Santa::Kotlin;
say Santa::Kotlin::reverse_string('lrep ot gnimoc si niltok atnas');
# OUTPUT: santa kotlin is coming to perl

These are good times to be a Perl kid, so happy holidays to all the good ones out there.

Happy hacking!

Elves Versus Unused Imports

2023-12-23T00:00:00Z

Santa's elves are interested in code quality. This is something we touched on about 9 years ago in How Santa's Elves Keep their Workshop Tidy and, more recently, in Elves Versus Typos. Since the elves like keeping up with the times, they are currently experimenting with another, newer Perl code quality tool. It's finally time to take a close look at perlimports. perlimports is a fixer -- it can rewrite your code for you. It's also a linter, so you can use it to report on problems without fixing them. With this power comes great responsibility and perlimports tries to be responsible. Inspired by goimports, perlimports is an opinionated tool which tries to force its opinions on your code. What you get in return is a tool which takes much of the burden of managing imports out of your hands.

If you're interested in an in-depth discussion of how perlimports and Perl's use and require work, check out this YouTube video from The Perl Conference in 2021: perlimports or "Where did that symbol come from?".

As a bonus, if you make it to the bottom of this article, we'll also explore a precious, which is a successor to Code::TidyAll.

Installation

Let's take a look at a typical getting started workflow. First the elves install the package from CPAN:

  cpm install -g App::perlimports

Once that is done, the elves are ready to try this out. They'll probably just dive right in. The quick way to run perlimports on a new repository might look something like this:

Getting Started

Clone a repo
Install *all* of the repository's dependencies (including recommended)
Run the test suite
Ensure all of the tests are passing. If there are test failures, fix those first
Run perlimports with the --lint flag to see what changes it might make
Tweak the configuration until we're happy with the linting results
Apply perlimports to the tests. We can do this via perlimports -i t
Ensure all of the tests are still passing
Commit the changes
Move on to other parts of the code, like lib. perlimports --lint lib

In a best case scenario, this "just works". Let's try it on a really old repository of mine.

$ git clone https://github.com/oalders/acme-odometer.git
$ cd acme-odometer/
$ cpm install -g --with-recommends --cpanfile cpanfile
$ yath t
$ perlimports --lint t

And indeed, all of the steps "just worked". We ran the test(s) via yath and they passed. Why did we use yath rather than make test or prove? We certainly could have done either of those things, but we're trying to get in the habit of using more modern tools. yath comes bundled with Test2::Harness. If you'd like to learn more about some of the features which Test2 provides, please see Santa’s Workshop Secrets: The Magical Test2 Suite (Part 1) and Santa’s Workshop Secrets: The Magical Test2 Suite (Part 2).

Now, let's see what the linting looks like:

    $ perlimports --lint t
    &#x274C; Test::Most (import arguments need tidying) at t/load.t line 1
    @@ -1 +1 @@
    -use Test::Most;
    +use Test::Most import =&gt; [ qw( done_testing ok ) ];

    &#x274C; Acme::Odometer (import arguments need tidying) at t/load.t line 3
    @@ -3 +3 @@
    -use Acme::Odometer;
    +use Acme::Odometer ();

    &#x274C; Path::Class (import arguments need tidying) at t/load.t line 4
    @@ -4 +4 @@
    -use Path::Class qw(file);
    +use Path::Class qw( file );

We can see three suggestions have been made. In the first suggestion, perlimports has detected that done_testing and ok are the only functions exported by Test::Most which the test is using, so it has made this explicit.

In the second suggestion perlimports has detected that the test is not importing any symbols from Acme::Odometer, so it has made this explicit by adding the empty round parens following the use statement.

In the third suggestion we see that some whitespace padding has been added to the Path::Class import.

If we don't like these changes, we can tweak the configuration. To tell perlimports to ignore Test::Most, we can change our incantation:

  perlimports --lint --ignore-modules Test::Most t

If we also don't like the additional padding, we can turn that off:

  perlimports --lint --ignore-modules Test::Most --no-padding t

Applying these settings we now get:

  $ perlimports --lint --ignore-modules Test::Most --no-padding t
  &#x274C; Acme::Odometer (import arguments need tidying) at t/load.t line 3
  @@ -3 +3 @@
  -use Acme::Odometer;
  +use Acme::Odometer ();

It's time to update the actual file. We'll use -i for an inplace edit:

  $ perlimports -i --ignore-modules Test::Most --no-padding t

The result is:

git --no-pager diff t
diff --git a/t/load.t b/t/load.t
index 503d560..d19688f 100644
--- a/t/load.t
+++ b/t/load.t
@@ -1,6 +1,6 @@
&nbsp;use Test::Most;

-use Acme::Odometer;
+use Acme::Odometer ();
&nbsp;use Path::Class qw(file);

&nbsp;my $path = file( 'assets', 'odometer' )-&gt;stringify;

Are the tests still passing?

yath t

** Defaulting to the 'test' command **

( PASSED )  job  1    t/load.t

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Yath Result Summary
-----------------------------------------------------------------------------------
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File Count: 1
Assertion Count: 3
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Wall Time: 1.00 seconds
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CPU Time: 1.42 seconds (usr: 0.32s | sys: 0.09s | cusr: 0.77s | csys: 0.24s)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CPU Usage: 142%
&nbsp;&nbsp;&nbsp;&nbsp;--&gt;  Result: PASSED  &lt;--

Excellent. Let's add the changes via git and commit them. After that, let's turn to the lib directory.

    $ perlimports --lint --ignore-modules Test::Most --no-padding lib
    &#x274C; namespace::clean (appears to be unused and should be removed) at lib/Acme/Odometer.pm line 9
    @@ -9 +8,0 @@
    -use namespace::clean;

    &#x274C; GD (import arguments need tidying) at lib/Acme/Odometer.pm line 11
    @@ -11 +11 @@
    -use GD;
    +use GD ();

    &#x274C; Memoize (import arguments need tidying) at lib/Acme/Odometer.pm line 12
    @@ -12 +12 @@
    -use Memoize;
    +use Memoize qw(memoize);

    &#x274C; Path::Class (import arguments need tidying) at lib/Acme/Odometer.pm line 14
    @@ -14 +14 @@
    -use Path::Class qw( file );
    +use Path::Class qw(file);

Now, we already see some issues. First off, perlimports doesn't seem to know about namespace::clean. That's ok. We can ignore it.

  perlimports --lint --ignore-modules namespace::clean,Test::Most --no-padding lib

As an aside, we could also update the code to use namespace::autoclean while we're poking around, but we're trying to make minimal changes in this first iteration.

The last suggestion is to remove the padding from the Path::Class imports. It's good to be consistent. The second and third suggestions look to be solid. Let's make this change.

  perlimports -i --ignore-modules namespace::clean,Test::Most --no-padding lib

That gives us:

$ git --no-pager diff lib
diff --git a/lib/Acme/Odometer.pm b/lib/Acme/Odometer.pm
index 7fee773..cb1734e 100644
--- a/lib/Acme/Odometer.pm
+++ b/lib/Acme/Odometer.pm
@@ -8,10 +8,10 @@ package Acme::Odometer;
&nbsp;use Moo 1.001;
&nbsp;use namespace::clean;

-use GD;
-use Memoize;
+use GD ();
+use Memoize qw(memoize);
&nbsp;use MooX::Types::MooseLike::Numeric qw(PositiveInt PositiveOrZeroInt);
-use Path::Class qw( file );
+use Path::Class qw(file);

That's pretty good. Do the tests still pass? Yes, they do. So, we can commit this change as well.

A Configuration File

Now, this is all well and good, but what if we want to run perlimports via the Perl Navigator Language Server? It would be better if we didn't have to worry about the custom command line switches. This sounds like a good time to create a config file.

perlimports --create-config-file perlimports.toml

Nice! We have a stub configuration file. Let's see what's inside perlimports.toml

# Valid log levels are:
# debug, info, notice, warning, error, critical, alert, emergency
# critical, alert and emergency are not currently used.
#
# Please use boolean values in this config file. Negated options (--no-*) are
# not permitted here. Explicitly set options to true or false.
#
# Some of these values deviate from the regular perlimports defaults. In
# particular, you're encouraged to leave preserve_duplicates and
# preserve_unused disabled.

cache                           = false # setting this to true is currently discouraged
ignore_modules                  = []
ignore_modules_filename         = &quot;&quot;
ignore_modules_pattern          = &quot;&quot; # regex like &quot;^(Foo|Foo::Bar)&quot;
ignore_modules_pattern_filename = &quot;&quot;
libs                            = [&quot;lib&quot;, &quot;t/lib&quot;]
log_filename                    = &quot;&quot;
log_level                       = &quot;warn&quot;
never_export_modules            = []
never_export_modules_filename   = &quot;&quot;
padding                         = true
preserve_duplicates             = false
preserve_unused                 = false
tidy_whitespace                 = true

Let's commit the stub file to git and then let's move our command line switches to the config file. The diff should look something like this:

$ git --no-pager diff perlimports.toml
diff --git a/perlimports.toml b/perlimports.toml
index d631998..1e54c9e 100644
--- a/perlimports.toml
+++ b/perlimports.toml
@@ -10,7 +10,7 @@
&nbsp;# preserve_unused disabled.

&nbsp;cache                           = false # setting this to true is currently discouraged
-ignore_modules                  = []
+ignore_modules                  = [&quot;namespace::clean&quot;, &quot;Test::Most&quot;]
&nbsp;ignore_modules_filename         = &quot;&quot;
&nbsp;ignore_modules_pattern          = &quot;&quot; # regex like &quot;^(Foo|Foo::Bar)&quot;
&nbsp;ignore_modules_pattern_filename = &quot;&quot;
@@ -19,7 +19,7 @@ log_filename                    = &quot;&quot;
&nbsp;log_level                       = &quot;warn&quot;
&nbsp;never_export_modules            = []
&nbsp;never_export_modules_filename   = &quot;&quot;
-padding                         = true
+padding                         = false
&nbsp;preserve_duplicates             = false
&nbsp;preserve_unused                 = false
&nbsp;tidy_whitespace                 = true

Integrations

That's it! Now, when we apply perlimports via Perl Navigator, our custom configuration will be respected. Also, we can now run perlimports from the command line without needing to include the --ignore-modules and --no-padding flags. We can think about adding perlimports to our Continuous Integration and pre-commit hooks as well, so that we maintain the changes we've just imposed.

As a bonus, if you are a neovim user and you're using null-ls or its successor none-ls, then perlimports is already available as a builtin. We can now apply perlimports as part of your "format on save" behaviours.

The Power of precious

We talked about using Code::TidyAll in How Santa's Elves Keep their Workshop Tidy. tidyall is a wonderful tool that solves a lot of problems, but its design was not perfect and it's looking for a new maintainer. In the meantime, precious has drawn inspiration from tidyall and can be regarded as its spiritual successor, even if it's written in Rust. If we want to run perlimports along with other fixing and linting tools, we can use precious for this.

We won't cover installation here, but after installing precious we can generate a stub config file:

$ precious config init --component perl

Writing precious.toml

The generated precious.toml requires the following tools to be installed:
&nbsp;&nbsp;https://metacpan.org/dist/Perl-Critic
&nbsp;&nbsp;https://metacpan.org/dist/Perl-Tidy
&nbsp;&nbsp;https://metacpan.org/dist/App-perlimports
&nbsp;&nbsp;https://metacpan.org/dist/Pod-Checker
&nbsp;&nbsp;https://metacpan.org/dist/Pod-Tidy

Let's have a look at the created file:

excludes = [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;.build/**&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;blib/**&quot;,
]

[commands.perlcritic]
type = &quot;lint&quot;
include = [ &quot;**/*.{pl,pm,t,psgi}&quot; ]
cmd = [ &quot;perlcritic&quot;, &quot;--profile=$PRECIOUS_ROOT/perlcriticrc&quot; ]
ok_exit_codes = 0
lint_failure_exit_codes = 2

[commands.perltidy]
type = &quot;both&quot;
include = [ &quot;**/*.{pl,pm,t,psgi}&quot; ]
cmd = [ &quot;perltidy&quot;, &quot;--profile=$PRECIOUS_ROOT/perltidyrc&quot; ]
lint_flags = [ &quot;--assert-tidy&quot;, &quot;--no-standard-output&quot;, &quot;--outfile=/dev/null&quot; ]
tidy_flags = [ &quot;--backup-and-modify-in-place&quot;, &quot;--backup-file-extension=/&quot; ]
ok_exit_codes = 0
lint_failure_exit_codes = 2
ignore_stderr = &quot;Begin Error Output Stream&quot;

[commands.perlimports]
type = &quot;both&quot;
include = [ &quot;**/*.{pl,pm,t,psgi}&quot; ]
cmd = [ &quot;perlimports&quot; ]
lint_flags = [&quot;--lint&quot; ]
tidy_flags = [&quot;-i&quot; ]
ok_exit_codes = 0
expect_stderr = true

[commands.podchecker]
type = &quot;lint&quot;
include = [ &quot;**/*.{pl,pm,pod}&quot; ]
cmd = [ &quot;podchecker&quot;, &quot;--warnings&quot;, &quot;--warnings&quot; ]
ok_exit_codes = [ 0, 2 ]
lint_failure_exit_codes = 1
ignore_stderr = [
&nbsp;&nbsp;&nbsp;&nbsp;&quot;.+ pod syntax OK&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;&quot;.+ does not contain any pod commands&quot;,
]

[commands.podtidy]
type = &quot;tidy&quot;
include = [ &quot;**/*.{pl,pm,pod}&quot; ]
cmd = [ &quot;podtidy&quot;, &quot;--columns&quot;, &quot;80&quot;, &quot;--inplace&quot;, &quot;--nobackup&quot; ]
ok_exit_codes = 0
lint_failure_exit_codes = 1

We can see that the config already includes a linting and tidying configuration for lots of helpful Perl linters and tidiers, including perlimports. Now, we can run precious tidy --all or precious lint --all to run all sorts of helpfu checks in pre-commit hooks and other places where code quality needs to be ensured.

precious is a powerful tool and it merits its own blog post, but let's leave this as a quick introduction. Perhaps you'll feel inspired to try it out.

The State of the Workshop

And as for Santa's elves? They have a large codebase which doesn't have 100% test coverage, so they're starting slowly with the changes introduced by perlimports. After applying perlimports to the test suite, they've also applied it to the files which have very good test coverage. Once they're confident in those changes, they'll move on to other parts of the codebase. Once they have an updated list of modules which perlimports should always ignore, maybe they'll even send in a patch to the maintainer. 🤞

St. Nick's Reindeers Need More H2O!

2023-12-22T00:00:00Z

Last year in 2022 [1], Santa Claus discovered a very useful Perl module called Util::H2O that makes it very seamless to add object oriented programming conveniences to Perl programs; it is particularly useful when it comes to adding Perl OOP to existing or legacy code bases.

Over the past year, he's done quite a bit of digging into a related module named, Util::H2O::More. The following is a summary of a few neat things available in this module, most of which are built upon Util::H2O's h2o method which gives accessors to to HASH references - and the inverse, that converts an blessed reference with accessors into a pure HASH reference, o2h. There's a mnemonic there, hash 2 object; and the reverse, oject 2 hash. All of the public methods try to follow this pattern, which will hopefully be apparent below.

Santa's Got Options... for Options

There are lots of modules on CPAN that present Getopt::Long in different ways. Util::H2O::More makes its entry into the mix with two different methods; one that builds upon the other.

The first is a nifty method called opt2h2o. This method makes it more convenient to define the fields of a reference destined to be objectified by h2o by using the parameter array description format used by Getopt::Long::GetOptionsFromArray.

opt2h2o is used to provide a list of default accessors to h2o to a given HASH reference. This reference is then provided to GetOptionsFromArray, as shown in the example below that can explain better than mere words:

use strict;
use warnings;
use Util::H2O::More qw/h2o opt2h2o/;
use Getopt::Long qw//;

my @opts = (qw/name=s country=s meaning=s/);
my $o = h2o { meaning =&gt; q{???} }, opt2h2o(@opts);     # example showing how to set default
Getopt::Long::GetOptionsFromArray( \@ARGV, $o, @opts );

if ($o-&gt;country) {
&nbsp;&nbsp;printf qq{Did you know, Santa is known as '%s' in the country/region of %s? It means, &quot;%s&quot;!\n},
&nbsp;&nbsp;&nbsp;&nbsp;$o-&gt;name, $o-&gt;country, $o-&gt;meaning;
}

Which results in,

prompt&gt; perl Santa-facts.pl --name Jultomten --meaning &quot;Christmas Brownie&quot; --country Sweden
Did you know, Santa is known as 'Jultomten' in the country/region of Sweden? It means, &quot;Christmas Brownie&quot;!

But as famous elvish pitchman, Willy Nays says, but wait, there's more ...!

Util::H2O::More has a method that combines everything, including the need to require Getopt::Long;, called Getopt2h2o; it can dramatically shorten the amount of typing needed to process options and provide accessors to the options:

use strict;
use warnings;
use Util::H2O::More qw/Getopt2h2o/;

my $o = Getopt2h2o \@ARGV, { meaning =&gt; q{???} }, qw/name=s country=s meaning=s/;

if ($o-&gt;country) {
&nbsp;&nbsp;printf qq{Did you know, Santa is known as '%s' in the country/region of %s? It means, &quot;%s&quot;!\n},
&nbsp;&nbsp;&nbsp;&nbsp;$o-&gt;name, $o-&gt;country, $o-&gt;meaning;
}

Which results in,

prompt&gt; perl ./Santa-facts.pl --name Christkindl --meaning &quot;Christ child&quot; --country Germany
Did you know, Santa is known as 'Christkindl' in the country/region of Germany? It means, &quot;Christ child&quot;!

Personally Santa prefers this version the best. He still loves brownies very much, as his waistline can attest - especially with red soda from the local grocer!

Ye Old Configuration Files

`Config::Tiny`

Util::H2O::More also has a couple of convenient options for handling conf files written in both .ini and YAML formats.

The first method is designed to provide accessors to configuration references provided by Config::Tiny; in fact there is no need to explicitly use or require Config::Tiny.

We begin with an INI format configuratino file, santa.ini:

  ; santa.ini
  ;   this is an ini file that is
  ;   used to power Santa&#39;s Facts
  ;   generating Perl script

  [SantaByCountry]
  Afghanistan=Aba Chaghaloo, ???
  Greece=&Alpha;&gamma;&iota;&omicron;&sigmaf; &Beta;&alpha;&sigma;&#x3AF;&lambda;&eta;&sigmaf;, Santa Clause
  Sweden=Jultomten, Christmas Brownie
  Austria=Christkind, Christ Child
  Switzerland=Christkindl, Christ Child
  Germany=Christkindle, Christ Child
  Mexico=Ni&ntilde;o Dios, God Child
  CentralAmerica=Ni&ntilde;o Jes&uacute;s, Baby Jesus

  ; sample from https://www.historiesdarkmysteries.com/2021/12/the-surprising-origins-of-jolly-old-st.html

Combining the joys of Getopt2h2o with ini2h2o, we get a pretty compact script with minimal set up. The example below is not missing it's statement to use Config::Tiny - ini2h2o handles that internally.

use strict;
use warnings;
use Util::H2O::More qw/Getopt2h2o ini2h2o/;

my $o = Getopt2h2o \@ARGV, { conf =&gt; q{./santa.ini} }, qw/conf=s/;

my $conf = ini2h2o $o-&gt;conf;

print qq{Did You Know:\n};
foreach my $country (keys %{$conf-&gt;SantaByCountry}) {
&nbsp;&nbsp;&nbsp;&nbsp;my $entry = $conf-&gt;SantaByCountry-&gt;$country;
&nbsp;&nbsp;&nbsp;&nbsp;my ($name, $meaning) = split /, +/, $entry;
&nbsp;&nbsp;&nbsp;&nbsp;printf qq{  + Santa is known as '%s' in the country/region of %s? It means, &quot;%s&quot;!\n},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$name, $country, $meaning;
}

And running this script with the configuration file yields,

prompt&gt; perl ./Santa-facts.pl
Did You Know:
&nbsp;&nbsp;+ Santa is known as 'Aba Chaghaloo' in the country/region of Afghanistan? It means, &quot;???&quot;!
&nbsp;&nbsp;+ Santa is known as 'NiÃ±o JesÃºs' in the country/region of CentralAmerica? It means, &quot;Baby Jesus&quot;!
&nbsp;&nbsp;+ Santa is known as 'NiÃ±o Dios' in the country/region of Mexico? It means, &quot;God Child&quot;!
&nbsp;&nbsp;+ Santa is known as 'Christkindle' in the country/region of Germany? It means, &quot;Christ Child&quot;!
&nbsp;&nbsp;+ Santa is known as 'Christkindl' in the country/region of Switzerland? It means, &quot;Christ Child&quot;!
&nbsp;&nbsp;+ Santa is known as 'Jultomten' in the country/region of Sweden? It means, &quot;Christmas Brownie&quot;!
&nbsp;&nbsp;+ Santa is known as 'Christkind' in the country/region of Austria? It means, &quot;Christ Child&quot;!
&nbsp;&nbsp;+ Santa is known as 'Î~QÎ³Î¹Î¿Ï~B Î~RÎ±Ï~CÎ¯Î»Î·Ï~B' in the country/region of Greece? It means, &quot;Santa Clause&quot;!

He is now able to build up a configuration file that has considerably more facts for his Did you know ...? script.

The script even uses the aforementioned method, Getopt2h2o, to enable a --conf flag in case Santa ever wanted to use a different configuration file.

prompt&gt; perl ./Santa-facts.pl --config ./santa2.ini
...

Given a $config reference, h2o2ini gives Santa the ability to write the reference back as an .ini file using Config::Tiny's write method underneath the hood.

If Santa had modifed the .ini file, then he could have written it back to disk using the inverse method, h2o2ini.

`YAML` Files

    ---
    Santa:
      By:
        Country:
          Afghanistan:
            name: Aba Chaghaloo
            meaning: ???
          Greece:
            name: &Alpha;&gamma;&iota;&omicron;&sigmaf; &Beta;&alpha;&sigma;&#x3AF;&lambda;&eta;&sigmaf;
            meaning: Santa Clause
          Sweden:
            name: Jultomten
            meaning: Christmas Brownie
          Austria:
            name: Christkind
            meaning: Christ Child
          Switzerland:
            name: Christkindl
            meaning: Christ Child
          Germany:
            name: Christkindle
            meaning: Christ Child
          Mexico:
            name: Ni&ntilde;o Dios
            meaning: God Child
          CentralAmerica:
            name: Ni&ntilde;o Jes&uacute;s
            meaning: Baby Jesus

Here, again, there is no need to use YAML. The yaml2h2o method employed below handles that behind the scenes, as well.

use strict;
use warnings;
use Util::H2O::More qw/Getopt2h2o yaml2h2o/;

# author note: added because it was needed with the YAML example
# but not the .ini example, not really sure why ...
use open qw( :std :encoding(UTF-8) );

my $o = Getopt2h2o \@ARGV, { conf =&gt; q{./santa.yaml} }, qw/conf=s/;

my ($conf) = yaml2h2o $o-&gt;conf;

print qq{Did You Know:\n};
foreach my $country (keys %{$conf-&gt;Santa-&gt;By-&gt;Country}) {
&nbsp;&nbsp;&nbsp;&nbsp;my $name = $conf-&gt;Santa-&gt;By-&gt;Country-&gt;$country-&gt;name;
&nbsp;&nbsp;&nbsp;&nbsp;my $meaning = $conf-&gt;Santa-&gt;By-&gt;Country-&gt;$country-&gt;meaning;
&nbsp;&nbsp;&nbsp;&nbsp;printf qq{  + Santa is known as '%s' in the country/region of %s? It means, &quot;%s&quot;!\n},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$name, $country, $meaning;
}

And running this script with the YAML configuration file now yields,

  prompt&gt; perl ./Santa-facts.pl
  Did You Know:
    + Santa is known as &#39;Aba Chaghaloo&#39; in the country/region of Afghanistan? It means, &quot;???&quot;!
    + Santa is known as &#39;Ni&ntilde;o Jes&uacute;s&#39; in the country/region of CentralAmerica? It means, &quot;Baby Jesus&quot;!
    + Santa is known as &#39;Ni&ntilde;o Dios&#39; in the country/region of Mexico? It means, &quot;God Child&quot;!
    + Santa is known as &#39;Christkindle&#39; in the country/region of Germany? It means, &quot;Christ Child&quot;!
    + Santa is known as &#39;Christkindl&#39; in the country/region of Switzerland? It means, &quot;Christ Child&quot;!
    + Santa is known as &#39;Jultomten&#39; in the country/region of Sweden? It means, &quot;Christmas Brownie&quot;!
    + Santa is known as &#39;Christkind&#39; in the country/region of Austria? It means, &quot;Christ Child&quot;!
    + Santa is known as &#39;&Alpha;&gamma;&iota;&omicron;&sigmaf; &Beta;&alpha;&sigma;&#x3AF;&lambda;&eta;&sigmaf;&#39; in the country/region of Greece? It means, &quot;Santa Clause&quot;!

There are many other cool aspects to Util::H2O::More that Santa wishes to show you, but he hopes that this Christmas break you discover all the time and lines of code that this module has to offer for a vast number of applications.

There is no h2o2yaml (or ways t handle JSON date either way), but if someone reading has the need, the author is quite active on Github and may be more than happy to help out a friend in need.

There is Still More!

Util::H2O::More is any Perl programmer's secret weapon for dealing with very common things that result ultimately in slinging around a bunch of HASH references - and occasionally, very complex structures that include ARRAY refs.

It builds on Util::H2O's massively powerful combination of h2o and o2h to provide ad hoc accessors to data in flight - and to remove them again when needed.

Some other pretty useful methods provided for by Util::H2O::More are:

baptise - a drop-in replacement for bless, but allows accessors to be defined:

use strict;
use warnings;

package Foo::Bar;

# exports 'h2o' also
use Util::H2O::More qw/baptise/;

sub new {
&nbsp;&nbsp;my $pkg    = shift;
&nbsp;&nbsp;my %opts   = @_;

&nbsp;&nbsp;# replaces bless, defines default constructures and creates
&nbsp;&nbsp;# constructors based on what's passed into %opts

&nbsp;&nbsp;my $self = baptise \%opts, $pkg, qw/bar haz herp derpes/;

&nbsp;&nbsp;return $self;
}

1;

d2o - like h2o, but dives deeply into ARRAY refs, e.g., that contain HASH refs; and applies h2o to them

o2d - like o2h, but acts on deeply objectified references that were created by d2o

ddd - a shortcut around dumping references to STDERR via Data::Dumper

Conclusion

Getting this far down into the article is quite an achievement. Congratulations for persevering with your faith in Perl. As you can see, Santa is very pleased to indulge in the true meaning of Christmas - which obviously, has everything to with spreading as much practical Perl knowledge as possible.

Joyeux Noël!

Elves Versus Typos

2023-12-21T00:00:00Z

When you're constantly producing things like toys and code, mistakes will happen. Some will be easy to spot and others may elude you. Santa knows that attention to detail counts. The elves know that if Santa finds a typo in their documentation or their code, he will immediately ask himself what else may be wrong. In order to avoid the impression of carelessness, the elves have automated the finding and fixing of typos.

The Tool

Strangely enough, one of the tools which the elves have in their toolkit is the typos utility. Now, this tool is not written in Perl, but rather in Rust. This bothers exactly nobody, since the elves use the right tool for the right job. The wonderful thing about typos is that this Rust-based tool can improve their Perl code. It's a Christmas miracle!

Getting Set Up

After installing typos, it's trivial to spot typos in code.

  $ typos

That's it! Now, let's try it on the Advent Calendar. We'll start with the articles in 2019.

  $ typos 2019

This gives us all sorts of helpful information.

    typos 2019
    error: `entires` should be `entries`
      --&gt; 2019/articles/2019-12-16.pod:253:23
        |
    253 | And start adding todo entires:
        |                       ^^^^^^^
        |
    error: `hightlight` should be `highlight`
      --&gt; 2019/articles/2019-12-14.pod:113:56
        |
    113 |         # work out the three strings (left of / before hightlight,
        |                                                        ^^^^^^^^^^
        |
    error: `hightlight` should be `highlight`
      --&gt; 2019/articles/2019-12-14.pod:114:24
        |
    114 |         # the middle / hightlight, and then right of / after highlight)
        |                        ^^^^^^^^^^
        |
    error: `assing` should be `assign`
      --&gt; 2019/articles/2019-12-14.pod:121:27
        |
    121 |         # what we want to assing to $x so we start drawing there again.

There are actually a few more typos, but this is a good demonstration of what we might find. Now, how do we fix it?

  $ typos -w 2019

    error: `fils` should be `fills`, `files`, `file`
      --&gt; 2019/articles/2019-12-20.pod:136:59
        |
    136 | if that machine can access the internet, if I can put the fils in my home
        |                                                           ^^^^
        |
    error: `whe` should be `when`, `we`
      --&gt; 2019/articles/2019-12-19.pod:25:17
       |
    25 | between runs.&quot;, whe Wise Old Elf explained sagely, &quot;Then you&#39;d be able to
       |                 ^^^
       |

This actually fixes a number of typos, but there are two which the tool cannot resolve, so it makes some suggestions for us to use in a manual fix.

This leaves the matter of how many changes were actually made. Let's see:

    $ git diff --stat 2019
     2019/articles/2010-12-11.pod | 2 +-
     2019/articles/2019-12-04.pod | 2 +-
     2019/articles/2019-12-05.pod | 4 ++--
     2019/articles/2019-12-07.pod | 4 ++--
     2019/articles/2019-12-10.pod | 2 +-
     2019/articles/2019-12-12.pod | 2 +-
     2019/articles/2019-12-13.pod | 8 ++++----
     2019/articles/2019-12-14.pod | 6 +++---
     2019/articles/2019-12-16.pod | 2 +-
     2019/articles/2019-12-18.pod | 6 +++---
     2019/articles/2019-12-20.pod | 4 ++--
     2019/articles/2019-12-21.pod | 4 ++--
     2019/articles/2019-12-22.pod | 2 +-
     2019/articles/2019-12-24.pod | 2 +-
     14 files changed, 25 insertions(+), 25 deletions(-)

We can now go over the changes individually via git add -p and we'll find that all but one seem to be correct. 24 typos found and fixed in 47 ms. That's not bad at all.

As we process more and more files, we will likely find some false positives which we want to correct. This can be done in a config file. Ours is typos.toml.

    [default.extend-words]
    ANDed = &quot;ANDed&quot;
    ba = &quot;ba&quot;
    Claus = &quot;Claus&quot;
    DNE = &quot;DNE&quot;
    IFF = &quot;IFF&quot;
    Signes = &quot;Signes&quot;

    [files]
    extend-exclude = [&quot;advent.ini&quot;, &quot;data.en&quot;]

In order to skip false positives, we add words to the default.extend-words section. Yes, it's kind of a surprising way to do this, but let's go along with it. Also, any files which we don't want to check can be added to extend-include in the [files] section.

Now The Elves Look Smart(er)

Having discovered this very useful tool, the elves have added it to their linters and fixers, made it part of their pre-commit hooks and included it in the Continuous Integration configuration.

For those of us who enjoy creating a quick pull request to fix someone else's typos, we can now employ this tool on repositories which we have just checked out. A helpful pull request for a grateful maintainer is just minutes away.

As one more data point, I used typos to check this very article and I'm both proud and ashamed to say that it found more than one problem. 😅

typos will not find all errors, but it will find issues which are hard for the human eye to spot. It's not a replacement for a code review, but it's a helpful tool for the elves to have in their toolbox for the days when they just don't see the typos which are staring them in the face. The best part is, they get to find the typos before Santa does.

A Dotenv Carol

2023-12-20T00:00:00Z

In the chilling corridors of Scrooge & Marley Software Solutions, Ebenezer Scrooge sat hunched over his laptop, hands clutching his hair, overwhelmed by failed deployments of his containers. Suddenly, a ghostly figure materialized before him – the Ghost of Configurations Past. It pointed at the stack of old, unwieldy JSON and YAML files in Scrooge's applications. "Behold, Ebenezer," moaned the specter, "the complexity and confusion of your past configurations. Remember the days of endless nested structures and tedious manual edits."

As the ghost swept Scrooge through the digital corridors of time, he saw himself wrestling with intricate configurations, wasting precious hours on syntax errors and misalignments. "There must be a simpler way," the ghost whispered.

Next appeared the Ghost of Configurations Present, adorned with snippets of Perl code and a merry demeanor. It took Scrooge to witness scenes of joyous developers using dotenv files – simple, readable, and devoid of unnecessary complexity. "Behold the present, Ebenezer!" the ghost declared. "Look at the ease with which developers manage all those different app environments. No more verbosity, no more headaches. Dotenv files bring clarity and simplicity to configuration management.".

"But how were they even able to change all that code to use .env files?", Ebenezer scoffed. "It must have cost a fortune to migrate!". The spectre quietly directed him to an open IDE, where a single line simply read:

    use ENV::Util -load_dotenv;

As Scrooge squinted at the line, the ghostly voice resonated. "ENV::Util is a lightweight module with zero dependencies. And just by adding that line, your %ENV will be populated with all the variables defined in your dotenv file, making it ready to use throughout your app." The old man remained skeptical. "Fine, but what if I want a configuration hash that's specific to my app, that I can for example iterate on, knowing it will only contain relevant settings?" The ethereal entity waved him to another terminal. "You mean like so?"

    my %config = ENV::Util::prefix2hash( &#39;MYAPP_&#39; )

"This will parse %ENV and return a key/value hash containing just the variables prefixed by 'MYAPP_'. It will even remove the prefix and lowercase variable names so they become more Perlish. This way a dotenv file with a line like this:"

    MYAPP_DB_SERVER_IP=127.0.0.1

"Can be accessed inside that hash as:"

    $config{db_server_ip}

Ebenezer was speechless. Then he remembered one of his past hurdles with configuration files. "That doesn't solve my main debugging issue! When thing go wrong, and in my line of business you know they will eventually, you sometimes need to dump all your configuration data, but that puts a lot of secrets in plain text in my logfiles!". With an unchanged demeanor, the apparition replied: "Then instead of dumping %ENV you can dump ENV::Util::redacted_env, which will mask the values of any keys that look sensitive, like the ones matching 'ID', 'EMAIL', 'TOKEN' or 'PASS':"

    use ENV::Util -load_dotenv;
    use Data::Printer;

    my %redacted = ENV::Util::redacted_env();
    p %redacted;

"You can even add your own rules as to what gets redacted and what doesn't. With ENV::Util, there really is no excuse to avoid dotenv files."

"It's a Christmas miracle!" Scrooge exclaimed, his eyes gleaming with newfound understanding.

But the Ghost of Configurations Yet to Come loomed ominously. It revealed a desolate future where Scrooge clung stubbornly to traditional configuration files in his apps, leading to confusion, inefficiency, disgruntled developers and... overtime.

"No more!" cried Scrooge, awakening from his spectral journey. "I have seen the error of my ways. With ENV::Util, I shall embrace the simplicity of dotenv files and bid farewell to the chains of complexity that bind my code."

And so, on that Christmas morning, Scrooge used ENV::Util and replaced his verbose configurations with a neat .env file. As the clock struck midnight, signaling the dawn of a new day, Scrooge's software team gathered, their faces beaming with joy. The office, once shrouded in the darkness of cumbersome configurations, now radiated the festive glow of efficient and readable dotenv files.

Perl - The Humane Programming Language

2023-12-19T00:00:00Z

Perl - The Humane Programming Language

Programming languages usually reflect the needs of the computer. We find ourselves typing verbose incantations, over and over. Our instructions are so detailed as to remove all ambiguity from them -- yet programs frequently don't do what we expect. The limitations of the programming language dictate how we think about and solve problems.

Perl is different. It puts you, the programmer, first. Larry Wall, Perl's creator was a linguist who brought many principles of natural language to Perl. As creators, we are at our most productive, contented selves when we get into the flow. Let's see what makes Perl the flow-state language.

Get the job done

Natural languages follow the Law of Brevity, where the most commonly used words are also the shortest. We modify our language to accommodate our time-preference. Perl aims for brevity too. Its keywords tend to be shorter than the traditional versions:

Traditional    Perl
-----------    ----
break          last
continue       next
filter         grep
function       sub
import         use
let            my
throw          die

Often entire words can be omitted. Subroutine declarations do not require a return statement, and may be called without parentheses. Built-in functions can operate on implicit variables like $_ instead of explicit arguments. This code loops over each line of input and splits the tab-separated line into an array, without ever referencing stdin or the line variable:

while (&lt;&gt;) {
&nbsp;&nbsp;chomp;
&nbsp;&nbsp;my @cols = split /\t/;
&nbsp;&nbsp;...
}

  &gt; People like things to be visually distinct from their surroundings. That&#39;s also why the various
  &gt; classes of operators and variables in Perl are visually distinct from each other. It&#39;s just
  &gt; sound human engineering.
  &gt; Larry Wall

By making variables, operators and function names visually distinct, Perl saves you reading time too.

Do What I Mean

Perl might be the most helpful of the dynamic languages. Take this Python function which adds 2 to any number its given:

def add2(n):
&nbsp;&nbsp;&nbsp;&nbsp;return n + 2

This function works fine when n is an int or float, but dies on stringified numbers like "5", because Python refuses to concatenate a string with the number 2. Now we're faced with a choice - should we cast n to a number type inside add2 or change every call site to cast the parameter to a number type before calling add2?

def add2(n):
&nbsp;&nbsp;&nbsp;&nbsp;return int(n) + 2 # or float(n) ?

Casting inside add2 means choosing which type to use (int or float), reducing its flexibility. Since call sites have more knowledge about the origin of n, that seems like the better trade off, but we'll always need to watch out for unsafe callers. Let's go another route:

def add2_i(n):
&nbsp;&nbsp;&nbsp;&nbsp;return int(n) + 2

def add2_f(n):
&nbsp;&nbsp;&nbsp;&nbsp;return float(n) + 2

We've lost the generic behavior of add2 but gained runtime safety without tracking call sites. And all we have to do is type out two versions of every number function we ever write! The dissatisfaction of programming in Python stems from the intuition that the experience should be better, i.e. more natural for the programmer. To have to write my code at the speed of a static language, but with the run time of a dynamic language just feels dumb.

In natural languages, context can change the meaning of the expression. Similarly, Perl uses context to change the type of an expression. The + operator forces a numeric context on its arguments, the concatenation operator ., a string context. With the ambiguity removed, there's no need to litter our code with type casts or extra functions:

sub add2 { shift + 2 }

Since text is the lingua franca of program input, Perl is optimized for the common case. Perl uses context to do what you mean.

Trust Me

  &gt; Perl is designed to let you program naturally. Whatever you think natural means.
  &gt; Larry Wall

Perl doesn't enforce a particular paradigm on the programmer. Everything isn't an object, but you're free to use the OO paradigm if you want to. There are no "private" attributes or methods. Any module, object or data structure can be printed, traversed and manipulated.

Want to inspect an object to see what it's made of? Use Data::Printer:

use Data::Printer 'p';

my $foo = Foo-&gt;new;
p $foo;

Perl trusts you to solve the problem as you see fit. If you want to fire off a bunch of computation at compile time, you can. If you want to use 90% of a module but monkey-patch that one method to behave how you need it, that's fine. Safer options for polymorphism include inheritance, traits, operator overloading and tied values.

You'll find it edifying to express your solution to a problem without being trammeled by a one-size-fits-all paradigm. You might say, There's More Than One Way To Do It.

Lessons Learned

Perl is an old language, with some features that seemed like a good idea at the time, but haven't panned out. Implicit variable declaration usually causes more trouble than its worth, so we use the strict pragma to turn it off (Python and Ruby still suffer from it).

Perl's interpreter threads are best left alone, and its reliance on global state makes implementing a good threading model a tall order. Process concurrency is easy with Parallel::ForkManager though, and IO::Async is good for asynchronous programming.

Perl used to lack proper booleans, relying on truthiness instead. This didn't always yield the best results, so they were added in v5.36. I still think Perl could use another type or two. For example "pairs" could make hash construction less brittle, and iteration easier.

And whilst Perl's concept of context works very well, it would be nice to have a meta-context model to program with, separate from the Perl interpreter. Santa, if you're listening forget the merino wool socks, add that to my list.

Wrapping Up

  &gt; Of all the programming languages I&#39;ve used, Perl is the only one where I never feel like
  &gt; I&#39;m fighting with the language.
  &gt; Martin, Software Engineer

This month many of us will be celebrating with friends and family. It's a time of appreciation and reflection. So ask yourself this - how much joy did your programming bring you this year?

Trimming audio files with Audio::Nama

2023-12-18T00:00:00Z

Our task

The elves' workshop has been as busy as ever this year. To help them pass the time when not gossiping or recounting heroic pranks of Christmases passed, Igvik Graybeard, one of the IT elves, has been piping music to the office, canteen and tool benches using cabling left over from an obsolete phone service.

In the last years the elves have gotten into radio plays, and Igvik wants to edit some old recordings he has to remove unwanted segments. In other words, he wants to extract relevant parts of an audio file, stitching them together into a new file. Igvik runs Linux and prefers to do his work in the terminal wherever possible. We've decided to help.

Our tools

We'll be accomplishing this with Audio::Nama, a multitrack recording mixing and audio-processing application written in perl, and Ecasound, a general-purpose audio engine. We also need git, which Nama uses to manage project state, provide for branching, undo, etc. nama is the executable program script and also man page, so "man nama" for the docs, or use nama's internal help.

Nama configures Ecasound for recording, mixing and a variety of tasks via an audio network definition called a chain setup. Aside from housekeeping duties, Nama's main task is to regenerate the chain setup (and re-configure the engine) whenever the graph changes due to user input, such as deactivating a track or changing an output -- a bit like how a spreadsheet recalculates as necessary.

The first run of nama creates a $HOME/nama directory for project files and a configuration file $HOME/.namarc.

Nama assumes a linux environment: that you'll be recording or listening from the default ALSA soundcard device, usually your computer's built-in soundcard. You can change this setting in namarc.

Create a new project, add a track and import an audio file

We'll create a new project called 'christmas'.

$ nama -c christmas

We get a startup banner, then an empty track listing:

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  MON     Main bus              CH 1/2        100    50
          2  Mixdown               OFF     track Main            --             --    --

        nama christmas Mixdown &gt;

In the prompt, 'christmas' is the project, 'Mixdown', the current track.

We create a separate track to accommodate our audio file, then import the file.

        nama christmas Mixdown &gt; add-track carol
        nama christmas carol &gt; import ~/music/christmas-carol.mp3

        format: s16_le,2,12000
        importing /home/jroth/music/christmas-carol.mp3 as /home/jroth/nama/christmas/.wav/carol_1.wav, converting to s16_le,2,44100,i

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  MON     Main bus              CH 1/2        100    50
          2  Mixdown               OFF     track Main            --             --    --
          3  carol                 PLAY    carol_1.wav           Main bus      100    50

We can now press SPACE to start/stop playback.

In the track listing above we see that track 'carol' with source carol_1.wav is set to PLAY. The output of 'carol' feeds the 'Main' track via the 'Main' bus. The 'Main' track serves as the master fader with output to the sound card. Like 'carol', all new tracks start as members of the 'Main' bus.

Define our clips

We will use a specialized type of bus called a 'sequence' to stitch together clips from our radio play. First we need to mark the beginning and end of each clip we want to keep.

We do that by listening to the track and using the clip-here command (bound to the F1 key) to mark clip starts and ends.

After some trial and error, we have the correct marks. In this example: four five-minute sections of content separated by 40-second breaks.

        nama christmas carol &gt; list-marks

        0 40.0 clip-start-0020
        1 340.0 clip-end-0021
        2 380.0 clip-start-0022
        3 680.0 clip-end-0023
        4 720.0 clip-start-0024
        5 1020.0 clip-end-0025
        6 1060.0 clip-start-0026
        *7 1360.0 clip-end-0027

The final gathering

We can now assemble our clips.

        nama christmas carol &gt; gather

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  MON     Main bus              CH 1/2        100    50
          2  Mixdown               OFF     track Main            --             --    --
          3  carol                 MON     carol sequence        Main bus      100    50

Note that the source for track 3 has changed from carol_1.wav to carol sequence.

Having listened to the output and resolved any hiccups (there were none!) we are ready to render it to an audio file.

        nama christmas carol &gt; mixdown
        Enabling mixdown to file

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  MON     Main bus              Mixdown       100    50
          2  Mixdown               REC v1  Main                  --             --    --
          3  carol                 MON     carol sequence        Main bus      100    50

        Now at: 0:00
        Engine is ready.
        Press SPACE to start the mixdown.

        Engine is running
        Engine is finished at 16:27

        recorded: Mixdown_1.wav
        Setting mixdown playback mode.

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  OFF     Main bus              --            100    50
          2  Mixdown               PLAY    Mixdown_1.wav         --             --    --
          3  carol            MON  OFF     carol sequence        --            100    50

The mixdown step also generates ogg and mp3 encodings with oggenc and lame, respectively, if desired. These files appear in the project directory:

~/nama/christmas/christmas_1.mp3 ~/nama/christmas/christmas_1.ogg ~/nama/christmas/christmas_1.wav is a symlink to ~/nama/christmas/.wav/Mixdown_1.wav

How the sausage is made

Chain setup graph

An Ecasound chain setup is made of signal-processing chains--edges in the processing graph--and loop devices, which are nodes capable of summing their inputs.

A chain represents a stream with one input and one output.

Here is a setup of one chain, omitting general options related to buffer sizes, etc.

        # audio inputs

        -a:3 -f:s16_le,2,44100 -i:/home/jroth/nama/christmas/.wav/carol_1.wav

        # audio outputs

        -a:3 -o:alsa,default

There is one chain, with label 3. Its input is from a .wav file, and its output goes to the default soundcard. There is an -f argument that describes the audio signal bit width, channel count and sample frequency.

Chains can terminate at an audio file, a sound device or a loop device. A loop device is a buffer stage that can sum the signal from one or more chains. It supplies the sum to another chain (or possibly multiple chains.) A loop device with its sources and an output chain can represent a mixer or bus.

Significantly for our task, a chain can represent an audio clip, part of an audio file that plays at a particular time.

        -a:5 -f:s16_le,2,44100 -i:playat,40,select,80,300,/home/jroth/nama/christmas/.wav/carol_1.wav

The 'select,80,300' object extracts 300 seconds of audio starting at 0:80. The 'playat,40' object plays the audio after a delay of 40 seconds.

Chains also perform effects processing. They can host plugins and plugin controllers called chain operators included in Ecasound and provided by numerous LADSPA and LV2 authors.

Basic mixer configuration

Each time a change in track status occurs, Nama generates a Chain setup file and commands Ecasound to load it.

Let's start with the mixer configuration when we imported our radio play.

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  MON     Main bus              CH 1/2        100    50
          2  Mixdown               OFF     track Main            --             --    --
          3  carol                 PLAY    carol_1.wav           Main bus      100    50

This is the corresponding chain setup:

        nama christmas carol &gt; chains

        # audio inputs

        -a:1 -f:s16_le,16,44100,i -i:loop,Main_in
        -a:3 -f:s16_le,2,44100 -i:/home/jroth/nama/christmas/.wav/carol_1.wav

        # audio outputs

        -a:1 -o:alsa,default
        -a:3 -f:s16_le,16,44100,i -o:loop,Main_in

Above we have two chains, labeled 1, and 3, corresponding to our tracks 'Main' and 'carol'.

Chain 3 reads carol_1.wav and sends its output to loop device Main_in. Chain 1 read the stream from Main_in and supplies it to the soundcard.

Debug output

By starting Nama with the -L ChainSetup logging option, we can see the steps from Nama's representation of the routing graph to the final chain setup. Initially, tracks in the graph are allowed to connect directly. Then the graph is simplified. Dead branches are removed. Finally, loop devices are introduced between tracks. I only include the graph where it changes.

        [1513] ChainSetup  (L 106) Graph after bus routing:
        wav_in-carol, carol-Main

        [1514] ChainSetup  (L 111) Graph after aux sends:
        [1514] ChainSetup  (L 114) Graph with paths from Main:
        wav_in-carol, carol-Main, Main-soundcard_out

        [1514] ChainSetup  (L 117) Graph with mixdown mods:
        [1514] ChainSetup  (L 216) Graph after simplify_send_routing:
        [1514] ChainSetup  (L 218) Graph after remove_out_of_bounds_tracks:
        [1514] ChainSetup  (L 220) Graph after recursively_remove_inputless_tracks:
        [1515] ChainSetup  (L 222) Graph after recursively_remove_outputless_tracks:
        [1515] ChainSetup  (L 122) Graph after pruning unterminated branches:
        [1515] ChainSetup  (L 126) Graph after adding loop devices:
        wav_in-carol, carol-Main_in, Main_in-Main, Main-soundcard_out

        [1515] ChainSetup  (L 130) Graph with inserts:

So this is our final graph:

        wav_in-carol, carol-Main_in, Main_in-Main, Main-soundcard_out

At this point, one end of each edge is a track. An edge--associating one track and one terminal--is sufficient to write an input or output line in the chain setup.

This happens through dispatch on the type of terminal, and generates IO objects, each used to write one line of the chain setup: a different class for each type of terminal.

        [1515] ChainSetup  (L 360) dispatch: wav_in -&gt; carol
        [1515] ChainSetup  (L 362) name: carol, endpoint: wav_in, direction: input
        [1516] ChainSetup  (L 360) dispatch: Main -&gt; soundcard_out
        [1516] ChainSetup  (L 362) name: Main, endpoint: soundcard_out, direction: output
        [1516] ChainSetup  (L 360) dispatch: carol -&gt; Main_in
        [1516] ChainSetup  (L 362) name: carol, endpoint: Main_in, direction: output
        [1516] ChainSetup  (L 360) dispatch: Main_in -&gt; Main
        [1516] ChainSetup  (L 362) name: Main, endpoint: Main_in, direction: input


        bless( {
          chain_id_ =&gt; 3,
          endpoint_ =&gt; &quot;wav_in&quot;,
          track_ =&gt; &quot;carol&quot;,
        }, &#39;Audio::Nama::IO::from_wav&#39; )

        bless( {
          chain_id_ =&gt; 1,
          endpoint_ =&gt; &quot;soundcard_out&quot;,
          track_ =&gt; &quot;Main&quot;,
        }, &#39;Audio::Nama::IO::to_alsa_soundcard_device&#39; )

        bless( {
          chain_id_ =&gt; 3,
          device_id_ =&gt; &quot;loop,Main_in&quot;,
          endpoint_ =&gt; &quot;Main_in&quot;,
          track_ =&gt; &quot;carol&quot;,
        }, &#39;Audio::Nama::IO::to_loop&#39; )

        bless( {
          chain_id_ =&gt; 1,
          device_id_ =&gt; &quot;loop,Main_in&quot;,
          endpoint_ =&gt; &quot;Main_in&quot;,
          track_ =&gt; &quot;Main&quot;,
        }, &#39;Audio::Nama::IO::from_loop&#39; )

These classes provide methods that can be overridden by field values annotated on the graph edges or graph nodes, with the edge (chain) values having the highest priority.

Overrides are used for mixdown and anywhere values for an IO object need to differ from those derived from the parent track.

Assembling our audio clips

We'll look at the project after we issued the gather command and entered <mixdown>, ready to render the sequenced clips. The output of track 'Main' feeds track 'Mixdown' which will write Mixdown_1.wav.

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ================================================================================
          1  Main                  MON     Main bus              Mixdown       100    50
          2  Mixdown               REC v1  Main                  --             --    --
          3  carol                 MON     carol sequence        Main bus      100    50

If we show hidden tracks, we see our four clips, each represented as a track. The source for each is the same audio file.

        nama christmas carol &gt; sha # show all tracks

         No. Name       Requested  Status  Source                Destination   Vol   Pan
        ===============================================================================
          1  Main                  MON     Main bus              CH 1/2        100    50
          2  Mixdown               OFF     track Main            --             --    --
          3  carol                 MON     carol sequence        Main bus      100    50
          4  carol-1-carol-v       PLAY    carol_1.wav           carol sequen  100    50
          5  carol-2-carol-v       PLAY    carol_1.wav           carol sequen  100    50
          6  carol-3-carol-v       PLAY    carol_1.wav           carol sequen  100    50
          7  carol-4-carol-v       PLAY    carol_1.wav           carol sequen  100    50

In the chain setup below we see that select and playat objects are used in the inputs to define a region of the audio file and play it with a given delay. The values were generated from our list of marks.

        # audio inputs

        -a:1 -f:s16_le,16,44100,i -i:loop,Main_in
        -a:3 -f:s16_le,16,44100,i -i:loop,carol_in
        -a:4 -f:s16_le,2,44100 -i:select,40,300,/home/jroth/nama/christmas/.wav/carol_1.wav
        -a:5 -f:s16_le,2,44100 -i:playat,300,select,380,300,/home/jroth/nama/christmas/.wav/carol_1.wav
        -a:6 -f:s16_le,2,44100 -i:playat,600,select,720,300,/home/jroth/nama/christmas/.wav/carol_1.wav
        -a:7 -f:s16_le,2,44100 -i:playat,900,select,1060,300,/home/jroth/nama/christmas/.wav/carol_1.wav
        -a:Mixdown -f:s16_le,16,44100,i -i:loop,Main_out

        # audio outputs

        -a:1 -f:s16_le,16,44100,i -o:loop,Main_out
        -a:3 -f:s16_le,16,44100,i -o:loop,Main_in
        -a:4,5,6,7 -f:s16_le,16,44100,i -o:loop,carol_in
        -a:Mixdown -f:s16_le,2,44100,i -o:/home/jroth/nama/christmas/.wav/Mixdown_1.wav

Some overriding was involved, as we see -a:Mixdown, a chain identifier that is not a track number. I think there was some technical reason, but it does stand out.

Thanks for reading!

Showcase

Jeanette Claassen has produced a large number of original songs using Nama in combination with various other music software and hardware. She began recording music using Ecasound and migrated to Nama as it became sufficiently featureful.

Notable dependencies

Git::Repository: Manage project history, branching, undo
Log::Log4perl: Logging, debugging
Parse::RecDescent: Command language parser
Object::Tiny: Accessor generator
Role::Tiny: Breaking up large classes
Term::ReadLine::Gnu: Terminal support, tab completion, history, hotkey mappings
Term::TermKey: More hotkey mappings
Graph: Representing, traversing and transforming the signal processing network
AnyEvent: Event loop
Tk: GUI, available with the -g option, use at your own risk!
Data::Section::Simple: Access sections within the __DATA__ block
Memoize: Turn expensive, redundant calculations into cheap lookups
Devel::NYTProf: Profiling to find and solve bottlenecks

Sequentially Consistent Santa

2023-12-17T00:00:00Z

Santa is finally introducing automation into his toy making operation, and this largely manifests itself as a large, black box that he or his elves are supposed to program with the build steps.

These magic boxes are programmed to follow a specific set of steps using a domain specific language (DSL) provided for by the mysterious makers of the boxen.

Nobody really knows how they work, not even Santa. Or so he claims. But provided they are able to trust the plan they give the machine, all is good in the North Pole and everyone gets their fill of eggnog.

Working with Lucas, his chief programmer elf, Santa wrote down the list of steps that he's perfected by manually building bikes over the last century. These instructions are superficially clear, but because there were lots of dependent steps, it was not so clear at all how they were going specify the proper ordering.

The steps that he gave his chief programming elf, Lucas, consisted of the following plan for building the perfect bike:

1. the bike frame must be forged, welded, and painted
2. the rear wheel may be attached to the frame once #1 is complete
3. the front wheel may be attached to the frame once #1 is complete
4. the seat may be added at any time after #1
5. handle bars must be attached before the front wheel (#3) is attached
6. the front brakes must be added after the front wheel (#3) is added
7. the rear brakes must be added after the rear wheel is added in #2
8. pedals and gears can be added at any time after #1
9. the chain must be added after the pedals and rear wheel (#8)
10. send bike to Buddy the Elf for testing

The work plans are fed into the box using the DSL format that is then read and processed by an internal module called Sub::Genius. A module aptly named since its original author is certainly not the brightest bulb in the shed. But the module is a good example of the many useful tools that exist on the Internet.

After being processed by Sub::Genius, the plan is turned into a set of actionable steps that the machine blindly follows. If the plan is correct, the end result will be a bicycle.

The plan is thusly:

    ForgeBike
    InitialPaint
    (
      ( ( RearWheel &amp; Pedals &amp; Gears ) ( RearBrakes &amp; Chain))
      &amp;
      ( Seat)
      &amp;
      ( HandleBars FrontWheel FrontBrakes )
    )
    Buddy2TestBike

So the elves do not need to list out every possible correct ordering, only ensure that dependent steps are expressed using a nested form that resemble a tree (similar in a lot of ways to LISP-y S-expressions).

Given the program, the magic box provides a way to serialize the execution of the plan into a sequential series of steps, all by using a Perl script:

use strict;
use warnings;
use Sub::Genius;

my $plan =&lt;&lt;EOP;
  ForgeBike
&nbsp;&nbsp;InitialPaint
&nbsp;&nbsp;(
&nbsp;&nbsp;&nbsp;&nbsp;( ( RearWheel &amp; Pedals &amp; Gears ) ( RearBrakes &amp; Chain))
&nbsp;&nbsp;&nbsp;&nbsp;&amp;
&nbsp;&nbsp;&nbsp;&nbsp;( Seat)
&nbsp;&nbsp;&nbsp;&nbsp;&amp;
&nbsp;&nbsp;&nbsp;&nbsp;( HandleBars FrontWheel FrontBrakes )
&nbsp;&nbsp;)
&nbsp;&nbsp;Buddy2TestBike
EOP

my $sg = Sub::Genius-&gt;new(preplan =&gt; $plan)-&gt;init_plan;

# print all sequential orderings of the steps described above
while (my $preplan = $sg-&gt;next()) {
&nbsp;&nbsp;print qq{$preplan\n};
}

When run, this prints all 588 possible correct orders of operations. A sequential set of steps is correct if it respects the partial ordering among dependent steps described in the plan above.

For example, HandleBars must always be installed before the RearBrakes. But the Pedals may be installed before or after the FrontBrakes. And in this way all independent tasks may be interleaved, i.e., may occur in any order; leaving the dependent steps occurring in the order in which they are constrained.

For example, some of the 588 possible correct orderings follow:

    ForgeBike InitialPaint Pedals Gears RearWheel HandleBars FrontWheel Chain RearBrakes Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint Pedals Gears RearWheel HandleBars FrontWheel Chain RearBrakes FrontBrakes Seat Buddy2TestBike
    ForgeBike InitialPaint Pedals Gears RearWheel Chain HandleBars RearBrakes FrontWheel Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint Pedals Gears RearWheel Chain HandleBars RearBrakes FrontWheel FrontBrakes Seat Buddy2TestBike
    ForgeBike InitialPaint Pedals Gears RearWheel Chain HandleBars RearBrakes Seat FrontWheel FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint Pedals Gears RearWheel Chain HandleBars FrontWheel RearBrakes Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint Pedals Gears RearWheel Chain HandleBars FrontWheel RearBrakes FrontBrakes Seat Buddy2TestBike
    ...
    ForgeBike InitialPaint HandleBars Gears FrontWheel RearWheel Pedals RearBrakes Chain Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel RearWheel Pedals RearBrakes Chain FrontBrakes Seat Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel RearWheel Pedals Chain RearBrakes Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel RearWheel Pedals Chain RearBrakes FrontBrakes Seat Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel Pedals RearWheel RearBrakes Chain Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel Pedals RearWheel RearBrakes Chain FrontBrakes Seat Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel Pedals RearWheel Chain RearBrakes Seat FrontBrakes Buddy2TestBike
    ForgeBike InitialPaint HandleBars Gears FrontWheel Pedals RearWheel Chain RearBrakes FrontBrakes Seat Buddy2TestBike

It would still be useful, one may suppose, if Lucas could only enumerate the steps in a properly ordered way. But alas, Sub::Genius is far more useful than that!

It so happens that if the subs with the same names as the steps of the plan are defined within the scope, then the plan may be actually executed. This allows for each step in the plan to have actions associated with them (even generating additional nested plans).

Because creating scripts to be executed according to the plan is a tedious task, one of the useful tools Sub::Genius provides is called stubby. This utility can be used to stub another Perl script with the sub already in place, just waiting to be filled with useful purpose.

E.g., if the plan above is saved to a file, let's call it ./bike.plan, we're able to generate a Perl script that contains subroutine stubs for each of the steps that appear in the plan at least once.

  shell&gt; stubby init -f ./bikes.plan --run once &gt; bikes.pl

The file bikes.pl is now filled with subroutines stubs that are waiting to be filled in with meaningful code, the script will look something like the following:

use strict;
use warnings;
use Sub::Genius;

my $plan = &lt;&lt;EOP;
  ForgeBike
&nbsp;&nbsp;InitialPaint
&nbsp;&nbsp;(
&nbsp;&nbsp;&nbsp;&nbsp;( ( RearWheel &amp; Pedals &amp; Gears ) ( RearBrakes &amp; Chain))
&nbsp;&nbsp;&nbsp;&nbsp;&amp;
&nbsp;&nbsp;&nbsp;&nbsp;( Seat)
&nbsp;&nbsp;&nbsp;&nbsp;&amp;
&nbsp;&nbsp;&nbsp;&nbsp;( HandleBars FrontWheel FrontBrakes )
&nbsp;&nbsp;)
&nbsp;&nbsp;Buddy2TestBike
EOP

my $sg = Sub::Genius-&gt;new( preplan =&gt; $plan )-&gt;init_plan;

my $final_scope = $sg-&gt;run_once;

sub ForgeBike {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Bike forged!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub InitialPaint {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Bike painted!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub HandleBars {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Handle bars on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub Gears {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Gears on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub RearWheel {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Rear wheels on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub Pedals {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Pedals on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub RearBrakes {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Rear brakes on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub FrontWheel {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Front wheels on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub Chain {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Chain on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub FrontBrakes {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Front brakes on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub Seat {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Seat on!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

sub Buddy2TestBike {
&nbsp;&nbsp;&nbsp;&nbsp;my $scope = shift;
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Ready to test, Buddy!\n};
&nbsp;&nbsp;&nbsp;&nbsp;return $scope;
}

And each time it's run, the overall ordering may change, but the ordering will always be correct based on the plan description:

    shell&gt; perl bike.pl

    Bike forged!
    Bike painted!
    Handle bars on!
    Front wheels on!
    Pedals on!
    Rear wheels on!
    Gears on!
    Rear brakes on!
    Chain on!
    Seat on!
    Front brakes on!
    Ready to test, Buddy!

    $ perl bike.pl
    Bike forged!
    Bike painted!
    Pedals on!
    Handle bars on!
    Front wheels on!
    Gears on!
    Rear wheels on!
    Rear brakes on!
    Chain on!
    Front brakes on!
    Seat on!
    Ready to test, Buddy!

    $ perl bike.pl
    Bike forged!
    Bike painted!
    Pedals on!
    Rear wheels on!
    Gears on!
    Chain on!
    Handle bars on!
    Rear brakes on!
    Seat on!
    Front wheels on!
    Front brakes on!
    Ready to test, Buddy!

Note: it is worth looking more into the raw stub file created since it give some nice hints about all the interesting things one may do by giving the subs state and passing along a $scope reference from one sub to another, as the sequential form of the plan is being executed.

And to make a very long story short, Perl saved Yet Another Christmas!

Prologue

Lucas ended up having such a joyful time working with coding the plan of the steps for creating the bikes, that he left us this nice little program as a parting gift.

But don't try to run it until the clock strikes midnight on December 25!

use strict;
use warnings;
use feature 'state';

use Sub::Genius ();

my $preplan = q{
&nbsp;(
&nbsp;&nbsp;&nbsp;HO &amp;
&nbsp;&nbsp;&nbsp;&nbsp;HO &amp;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;HO
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)
&nbsp;Merry Christmas To All
};

my $sq = Sub::Genius-&gt;new(preplan =&gt; qq{$preplan} );
$sq-&gt;init_plan;
my $final_scope = $sq-&gt;run_once( scope =&gt; {}, ns =&gt; q{main}, verbose =&gt; 0);

#
# S U B R O U T I N E S
#

sub HO {
&nbsp;&nbsp;state $mystate = 0;
&nbsp;&nbsp;if ($mystate == 0) {
&nbsp;&nbsp;&nbsp;&nbsp;print qq{Merry Christmas to All,\nAnd };
&nbsp;&nbsp;&nbsp;&nbsp;++$mystate;
&nbsp;&nbsp;}
&nbsp;&nbsp;elsif ($mystate == 1) {
&nbsp;&nbsp;&nbsp;&nbsp;print qq{to };
&nbsp;&nbsp;&nbsp;&nbsp;++$mystate;
&nbsp;&nbsp;}
&nbsp;&nbsp;elsif ($mystate == 2) {
&nbsp;&nbsp;&nbsp;&nbsp;print qq{All, };
&nbsp;&nbsp;&nbsp;&nbsp;++$mystate;
&nbsp;&nbsp;};
}

sub Merry {
&nbsp;&nbsp;print qq{A };
}

sub Christmas {
&nbsp;&nbsp;print qq{Good };
}

sub To  {
&nbsp;&nbsp;print qq{Night};
};

sub All {
&nbsp;&nbsp;print qq{!\n};
};

The story does not end here, but it is time to conclude this chapter. Santa and Lucas successfully programmed the magick black box, and countless children received their bikes. A lucky few received a scooter and fez cap instead, but that's a story for a different Advent.

https://metacpan.org/pod/Sub::Genius - includes info on how this all works
https://metacpan.org/pod/FLAT - processing engine
https://en.wikipedia.org/wiki/S-expression

Santa’s Workshop Secrets: The Magical Test2 Suite (Part 2)

2023-12-16T00:00:00Z

Greetings, festive readers! Santa Claus here, ready to share yet another behind-the-scenes look at how we keep Christmas joyfully on track with the Magical Test2 Suite, soon to be a core test library in Perl 5.40 onwards.

If you haven't read part 1, it's a real treat!

Just like the tinsel on your tree, mocks add that extra sparkle to our unit tests. Mocks can help us simulate certain behaviors, creating a controlled environment for unit testing. We can create mock classes, objects or methods in order to properly test others that interact with them.

And with the Test 2 Suite, this has never been easier!

Easily mocking objects and classes

For starters, let’s say you want to create an object that will be passively called by whatever it is you’re testing:

use Test2::V0;

my $obj = mock;

Now, $obj is a dud that will accept any method calls and return undef. What about if you want it to return something specific?

my $obj = mock { merry =&gt; 'christmas!' };

is $obj-&gt;merry, 'christmas!', 'my mock works';

When you need to test chained calls, you can always nest your mocks():

my $obj = mock {
&nbsp;&nbsp;&nbsp;&nbsp;happy =&gt; mock {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;holidays =&gt; mock {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;everyone =&gt; 'Ho! Ho! Ho!'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}
};

is $obj-&gt;happy-&gt;holidays-&gt;everyone, 'Ho! Ho! Ho!', 'chained mocks';

"But Santa", you may ask, "What about when the class is instantiated and used somewhere inside the code I want to test? How can I use mocks to add or override methods to something out of my hands?" No worries! Just expand your mock definition for more control:

my $mock_meta = mock 'Some::Class' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;track =&gt; true,
&nbsp;&nbsp;&nbsp;&nbsp;override =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;some_method  =&gt; sub { ... },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;other_method =&gt; sub { ... },
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;add =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;new_method =&gt; sub { ... },
&nbsp;&nbsp;&nbsp;&nbsp;],
);

And now, as long as $mock_meta exists, any instances of "Some::Class" will have the mocked behavior. To restore them back to the original, simply undefine that $mock_meta variable or call $mock_meta->reset_all().

One thing you may have noticed in the example above is the "track => true". That means $mock_meta will contain a lot of information ready for you to inspect regarding how many times any given method was called, and which arguments were used. This is particularly important to check if the code you’re testing is properly invoking the mocked class.

test_something_that_uses_my_mocked_class();
is(
&nbsp;&nbsp;&nbsp;&nbsp;$mock_meta-&gt;sub_tracking-&gt;{some_method}-&gt;@*,
&nbsp;&nbsp;&nbsp;&nbsp;1,
&nbsp;&nbsp;&nbsp;&nbsp;'some_method() called only once!'
);

like(
&nbsp;&nbsp;&nbsp;&nbsp;$mock_meta-&gt;sub_tracking-&gt;{some_method}[0]{args},
&nbsp;&nbsp;&nbsp;&nbsp;[ qr(), 'arg1', qr(arg2) ],
&nbsp;&nbsp;&nbsp;&nbsp;'testing call arguments for method &quot;some_method&quot;'
);

$mock_meta-&gt;clear_sub_tracking(); # so we can go again in isolation

Note that to get the mock metadata from a given variable holding an object, you can also do:

my ($mock_meta) = mocked $actual_obj;

Mocking the Christmas Wishlist Database

For a real world example, let's see how the elves use Test2 Suite's mocking features to test our gift delivery system. The code looks roughly like this:

sub deliver_gift ($child_name, $gift_name) {
&nbsp;&nbsp;&nbsp;&nbsp;my $schema = GiftDB::Schema-&gt;get_active_connection();
&nbsp;&nbsp;&nbsp;&nbsp;my $wish = $schema-&gt;resultset('Wishlist')-&gt;single({
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; $child_name, gift =&gt; $gift_name
&nbsp;&nbsp;&nbsp;&nbsp;});

&nbsp;&nbsp;&nbsp;&nbsp;if ($wish &amp;&amp; $wish-&gt;update({ delivered =&gt; true })) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return 'delivered!';
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;return 'oh, no...';
}

The function looks simple enough: we get an active database connection, select the wishlist table/resultset, and see if we can find the child's wishlist entry. If we have it, we update the entry to 'delivered'.

But how do we test it without actually using a database? We mock the database, that's how!

use builtin qw( true false weaken );
use Test2::V0;

# mock simple resultsets and results:
my $mock_wishlist_rs = mock 'obj' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;track =&gt; true,
&nbsp;&nbsp;&nbsp;&nbsp;add =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;single =&gt; sub ($self, $) { weaken $self; return $self },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;update =&gt; true,
&nbsp;&nbsp;&nbsp;&nbsp;],
);

# mock the main schema, and point calls to resultset()
# to our mock_wishlist_rs:
my $mock_schema = mock 'GiftDB::Schema' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;track =&gt; true,
&nbsp;&nbsp;&nbsp;&nbsp;override =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;get_active_connection =&gt; sub ($class) { $class },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;resultset =&gt; sub { $mock_wishlist_rs },
&nbsp;&nbsp;&nbsp;&nbsp;],
);

# That's it! Now let's write some tests:
plan 5;

is(
&nbsp;&nbsp;&nbsp;&nbsp;Magic::Santa::Sack::deliver_gift('anna', 'starship'),
&nbsp;&nbsp;&nbsp;&nbsp;'delivered!',
&nbsp;&nbsp;&nbsp;&nbsp;&quot;works when we have the gift&quot;
);

like(
&nbsp;&nbsp;&nbsp;&nbsp;$mock_schema-&gt;sub_tracking-&gt;{resultset},
&nbsp;&nbsp;&nbsp;&nbsp;[ { args =&gt; [ 'GiftDB::Schema', 'Wishlist' ] }, DNE ],
&nbsp;&nbsp;&nbsp;&nbsp;'call to resultset() asks for the right table (wishlist)'
);

my ($meta_wishlist_rs) = mocked($mock_wishlist_rs);
like(
&nbsp;&nbsp;&nbsp;&nbsp;$meta_wishlist_rs-&gt;call_tracking,
&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ args =&gt; [ D(), { name =&gt; 'anna', gift =&gt; 'starship' }, DNE() ], sub_name =&gt; 'single' },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ args =&gt; [ D(), { delivered =&gt; true }, DNE() ], sub_name =&gt; 'update' },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;DNE()
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;'wishlist resultset properly manipulated'
);

# clear tracking so we can test again:
$meta_wishlist_rs-&gt;clear_call_tracking;

# now let's see if it works as expected when the
# database can't find the child/gift pair. We emulate
# this in our mock by making the call to single()
# return false instead:
$meta_wishlist_rs-&gt;override( 'single' =&gt; false );

is(
&nbsp;&nbsp;&nbsp;&nbsp;Magic::Santa::Sack::deliver_gift('anna', 'starship'),
&nbsp;&nbsp;&nbsp;&nbsp;'oh, no...',
&nbsp;&nbsp;&nbsp;&nbsp;&quot;fails when we don't have the gift&quot;
);
like(
&nbsp;&nbsp;&nbsp;&nbsp;$meta_wishlist_rs-&gt;call_tracking,
&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ args =&gt; [ D(), { name =&gt; 'anna', gift =&gt; 'starship' }, DNE() ], sub_name =&gt; 'single' },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;DNE()
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;'wishlist resultset queried with proper args'
);

So there you have it. With the magical powers of Test2, when Christmas Eve arrives, I’ll take off on my sleigh with confidence, knowing that every toy has passed its tests. This means more smiles, laughter, and Christmas joy for people all around the world. Give it a try, too, and may your code be as merry and bright as the star on top of your tree.

– Santa, out.

Santa’s Workshop Secrets: The Magical Test2 Suite (Part 1)

2023-12-15T00:00:00Z

Ho, ho, ho, dear friends! Tonight I have a little behind-the-scenes to share with you directly from the North Pole. As you all know, this season is pretty busy for me and the elves. We have to make sure every letter is received, assigned and fulfilled, and that every present is in tip-top condition and delivered on time. So, of course, our Christmas operation needs to be tested thoroughly.

But writing good tests can sometimes be a coal in the stocking. Some things are hard to test, and even though Perl has many nice testing modules to help with that, I can never quite remember their names or which to use, and together they can add so many external dependencies that we mostly keep ourselves to Test::More.

Well, not anymore. This year we updated all our test code to use the magical Test2-Suite. A single distribution that updates and replaces not just Test::More, but many other testing modules. And the best part? It will be a core distribution in Perl 5.40 onwards! Talk about a Christmas Miracle <3

The basics work pretty much like Test::More, so if you’re used to it you’ll feel right at home. In fact, if you’re not doing anything fancy you can probably replace "use Test::More" with "use Test2::V0" and everything will work just fine. Check it out:

use Test2::V0;

use Acme::Christmas;

ok my $xmas = Acme::Christmas-&gt;new, 'able to instantiate object';
isa_ok $xmas, 'Acme::Christmas';
can_ok $xmas, qw( read_letters make_toys );

is $xmas-&gt;date, 'December, 25th', 'got the right date';

note &quot;letâ~@~Ys see if the Grinch is close&quot;;
subtest 'assert that the grinch is far away' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;if (grinch()) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;fail 'oh, noesâ~@¦';
&nbsp;&nbsp;&nbsp;&nbsp;} else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;pass 'coast is clear!';
&nbsp;&nbsp;&nbsp;&nbsp;}
};

SKIP: {
&nbsp;&nbsp;&nbsp;&nbsp;skip &quot;tests for winter only&quot;, 1 unless $xmas-&gt;is_winter;
&nbsp;&nbsp;&nbsp;&nbsp;like $xmas-&gt;carol, qr/Merry/, â~@~Xfound the proper lyricsâ~@~Y;
}

done_testing; # you can also &quot;plan N;&quot; if you prefer to count your tests.

But you’ll also get some nice cranberry sauce right out of the box. For starters, strict and warnings are on by default (and don’t worry, you can easily disable this behavior if you want). Second, remember how you always wanted tests to print more useful debug data when they fail? Now you can! Test2::V0’s is(), ok(), like() and most other test functions support extra arguments after the test description, so you can write them as:

ok $xmas-&gt;ready, &quot;test if christmas is ready&quot;
&nbsp;&nbsp;&nbsp;&nbsp;=&gt; &quot;hmm... this was not supposed to fail. Let's see...&quot;
&nbsp;&nbsp;. &quot; the tree is &quot; . $xmas-&gt;tree
&nbsp;&nbsp;. &quot; and we have &quot; . $xmas-&gt;presents-&gt;count . &quot; wrapped gifts.&quot;
&nbsp;&nbsp;;

and all that extra output will be printed only if the test fails. Ho! Ho! Ho!

The all-powerful "is" and "like"

This is straight out my favorite feature. You may have noticed I did not include "is_deeply()" on the list of compatibility with Test::More. Well, that’s because there is no need for it. That’s right! If the variable you’re testing is a data structure, you can simply use is() and it will do a deep check, failing if values don’t match or if anything is missing:

is $recipe, {
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; 'Fruitcake',
&nbsp;&nbsp;&nbsp;&nbsp;ingredients =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;eggs =&gt; 5,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;flour =&gt; 3,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'dried fruit' =&gt; ['cherries', 'apricots', 'dates'],
&nbsp;&nbsp;&nbsp;&nbsp;},
}, 'got proper dessert!';

What about that time of the year when you get a data structure or object and care only about a few keys, items or attributes? Ooh, Santa’s got a gift for you, too! Use like() with the nested structure to ignore any keys/positions you haven’t defined in a true non-strict (partial) match. It even lets you mix and match between exact values (by passing a string or a number) and values that match a regular expression (by providing the regexp).

like $recipe, {
&nbsp;&nbsp;&nbsp;&nbsp;name =&gt; qr(cake)i,  # must contain â~@~Xcakeâ~@~Y (case insensitive)
&nbsp;&nbsp;&nbsp;&nbsp;ingredients =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;eggs =&gt; qr(\d+),   # any number
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;flour =&gt; 5,            # exactly 5
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dried fruitâ~@~Y =&gt; [qr/cherr(y|ies)/, 'apricots', qr/dates?/],  # mix and match!
&nbsp;&nbsp;&nbsp;&nbsp;}
}, 'partial match in nested variables, mixing is() and like() at any level';
```

Think the presents are over? Think again! For even more complex validations you can check your variable against a builder (and there are many builders available for hashes, arrays, objects, etc). For example, let’s say I wanted to check whether $recipe has a name and ingredients, and if one of the dried fruits is raisins. Also, just to make it a little harder, let’s make sure it has no key called ‘microwave’. To do all that, we just write a very simple definition of our partial hash containing only the bits we care about:

# import everything we use in this test
# (the :DEFAULT label is to ensure all regular symbols are also imported)
use Test2::V0 qw( :DEFAULT hash field bag item etc L DNE );

is $recipe, hash {
&nbsp;&nbsp;field name =&gt; L;  # the value of the 'name' key is defined and has a L()ength.
&nbsp;&nbsp;field ingredients =&gt; hash {
&nbsp;&nbsp;&nbsp;&nbsp;# 'bag' is an 'array' that doesn't care about element order.
&nbsp;&nbsp;&nbsp;&nbsp;field 'dried fruit' =&gt; bag { item 'raisins'; etc; };
&nbsp;&nbsp;&nbsp;&nbsp;etc;
&nbsp;&nbsp;};
&nbsp;&nbsp;field microwave =&gt; DNE; # the 'microwave' key Does Not Exist.
&nbsp;&nbsp;etc;    # ignore other keys. Use 'end' to fail the test if other keys exist.
}, 'partial match from a generated definition!';

If that wasn’t impressive enough, here are some extra nice ways to make your tests more thorough, robust and clear without having to load external modules or fiddle with the symbol table:

Test if loading a module imports (or doesn’t import) a function or a variable:

use Some::Module;
imported_ok 'mysub', '$myvar', '@myothervar';
not_imported_ok 'othersub', '$othervar';
```

Test if something warns or dies / raises an exception

like dies { â~@¦ }, qr/some error/, 'got expected exception from block';
ok lives { â~@¦ }, 'code lived!', &quot;oh, noes! Died with error '$@'&quot;;

ok warns { â~@¦ }, 'at least one warning was issued in the block';
is warns { â~@¦ }, 2, 'got the right number of warnings in block';

is warnings { â~@¦ }, [
&nbsp;&nbsp;&nbsp;&nbsp;qr/first warning issued/,    # lax match
&nbsp;&nbsp;&nbsp;&nbsp;'second warning issued in somefile.pl line 10',  # strict match,
], 'matched expected warning messages';

Stop and bail out of testing whenever a single test fails:

If you add this to the beginning of your test file, it will die and stop testing that file as soon as any test on that file fails:

use Test2::Plugin::DieOnFail;

If you’re running a bunch of different test files, it will not stop testing altogether, just that particular file. To truly bail out of all testing as soon as any test on a file fails, do this instead:

use Test2::Plugin::BailOnFail;

If you just want to bail on a single test in the file, use "... or bail_out($reason)" after the test.

Skip tests unless we have a specific perl or module version available:

# skip all tests in file unless perl is v5.38 or greater:
use Test2::Require::Perl 'v5.38';

# skip all tests in file unless â~@~XSome::Module version 2.34 or greater is available.
# omit the version if you only care about whether the module is available or not.
use Test2::Require::Module 'Some::Module' =&gt; '2.34'

Now please excuse this old man because I have to feed the reindeer really well before the big day. But grab a gingerbread cookie and stay tuned for part 2 of Santa's Workshop Secrets. I'll be back in a jiffy with my favorite new tool in the Test2 Suite: mocks!

– Santa, out.

Introduction to class feature

2023-12-14T00:00:00Z

Background

I have followed the last 2 releases of Perl i.e. Perl v5.36 and Perl v5.38 very closely. Perl v5.36 was released on 2022-05-28 with much fanfare as it had so much nice new features introduced. If you haven't had chance to play with then I have compiled some for you. Please check out this collection for quick introduction.

Following the release of Perl v5.36, the discussion of new object system Corinna took the limelight as it was one of the main features to be introduced with Perl v5.38. Then finally on 2023-07-02, we had Perl v5.38 released.

After the release, I wanted to try new class feature but never got the opportunity to play with it.

I have played with Design Patterns using the Moo based object in the past. So I thought why not pick one of the design pattern and try with the new class feature.

Singleton using Moo

As you see the code below, it is such a lightweight implementation of Singleton using Moo with MooX::Singleton. The only issue I have is the dependency on non-core module.

package SingleObject;

use Moo;
with 'MooX::Singleton';

has 'count' =&gt; (is =&gt; 'rw', default =&gt; sub { 0 });

sub counter {
&nbsp;&nbsp;&nbsp;&nbsp;my ($self) = @_;

&nbsp;&nbsp;&nbsp;&nbsp;return $self-&gt;count($self-&gt;count + 1);
}

print SingleObject-&gt;instance-&gt;counter, &quot;\n&quot;;
print SingleObject-&gt;instance-&gt;counter, &quot;\n&quot;;
print SingleObject-&gt;instance-&gt;counter, &quot;\n&quot;;
print SingleObject-&gt;instance-&gt;counter, &quot;\n&quot;;
print SingleObject-&gt;instance-&gt;counter, &quot;\n&quot;;

This gives us the following output:

Implementation of Singleton using new class feature

With the Perl v5.38 release, we no longer have the dependency on external modules as seen in the code below:

use v5.38;
use experimental 'class';

class Singleton 0.01 {
&nbsp;&nbsp;&nbsp;&nbsp;my $instance;
&nbsp;&nbsp;&nbsp;&nbsp;sub instance($class) { $instance //= $class-&gt;new }
}

class SingleObject :isa(Singleton) {
&nbsp;&nbsp;&nbsp;&nbsp;field $count :param = 0;
&nbsp;&nbsp;&nbsp;&nbsp;method counter { ++$count }
}

say SingleObject-&gt;instance-&gt;counter;
say SingleObject-&gt;instance-&gt;counter;
say SingleObject-&gt;instance-&gt;counter;
say SingleObject-&gt;instance-&gt;counter;
say SingleObject-&gt;instance-&gt;counter;

This gives us exactly the same output as above.

How about some more?

Well, I then tried to show inheritance using new class feature. It looks amazingly compact and clean.

use v5.38;
use experimental 'class';

class Animal {
&nbsp;&nbsp;&nbsp;&nbsp;method eat { say &quot;I can eat!&quot; }
}

class Dog :isa(Animal) {
&nbsp;&nbsp;&nbsp;&nbsp;method bark { say &quot;Woof Woof!&quot; }
}

my $dog = Dog-&gt;new;
$dog-&gt;eat();
$dog-&gt;bark();

This gives us the following output:

    I can eat!
    Woof Woof!

That's it for now until we meet again.

Santa's New Dispatcher

2023-12-13T00:00:00Z

St. Nick's had computer problems nearly non-stop this year, and at a critical time he's been unable to access any letters "To Santa" that have been emailed to him, which is quite a few considering this Internet fad doesn't seem to be slowing down any time soon.

To that end, at this critical hour he's decided to write a Perl script that will automatically assign a toy to a child based on the starting letter of their first name and the random flip of a coin.

At first pass, his code seems to do what he wants; but it's a nasty set of if-elsif-else statements. Mrs. Clause would most certainly not find it very nice!

use strict;
use warnings;

my (@teddybear,    @rockinghorse,
&nbsp;&nbsp;&nbsp;&nbsp;@jackinthebox, @gijoe,
&nbsp;&nbsp;&nbsp;&nbsp;@barbie,       @sallytalksalot,
&nbsp;&nbsp;&nbsp;&nbsp;@teaset,       @dollhouse);

sub get_child() {
&nbsp;&nbsp;qw/al grant mary salve/; # e.g., ...
};

foreach my $CHILD ( get_child() ) {
&nbsp;&nbsp;if ($CHILD =~ m/^[a-fA-F]/) {
&nbsp;&nbsp;&nbsp;&nbsp;if (int rand 2 == 0) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @teddybear, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @dollhouse, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;}
&nbsp;&nbsp;elsif ($CHILD =~ m/^[g-lG-L]/) {
&nbsp;&nbsp;&nbsp;&nbsp;if (int rand 2 == 0) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @rockinghorse, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @teaset, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;}
&nbsp;&nbsp;elsif ($CHILD =~ m/^[m-rM-R]/) {
&nbsp;&nbsp;&nbsp;&nbsp;if (int rand 2 == 0) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @jackinthebox, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @sallytalksalot, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;}
&nbsp;&nbsp;elsif ($CHILD =~ m/^[s-zS-Z]/) {
&nbsp;&nbsp;&nbsp;&nbsp;if (int rand 2 == 0) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @gijoe, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @barbie, $CHILD;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;}
}

After a brief pause, Santa thought that maybe he could organize this code into a more efficient and nicer to read dispatch table based on a HASH structure. But alas! He could not figure out how to do it without actually having a key in place for each possible first name. There was also a lot of repeated code in the CODE attached to each HASH key.

use strict;
use warnings;

my (@teddybear,    @rockinghorse,
&nbsp;&nbsp;&nbsp;&nbsp;@jackinthebox, @gijoe,
&nbsp;&nbsp;&nbsp;&nbsp;@barbie,       @sallytalksalot,
&nbsp;&nbsp;&nbsp;&nbsp;@teaset,       @dollhouse);

sub get_child() {
&nbsp;&nbsp;qw/al grant mary salve/; # e.g., ...
};

foreach my $CHILD ( get_child() ) {
&nbsp;&nbsp;&nbsp;&nbsp;my $dispatch = {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;al =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if   ( int rand 2 == 0 ) { push @teddybear, $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else                     { push @dollhouse, $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},

        # ...
        grant =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if   ( int rand 2 == 0 ) { push @rockinghorse, $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else                     { push @teaset,       $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},

        # ...
        mary =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if   ( int rand 2 == 0 ) { push @jackinthebox,   $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else                     { push @sallytalksalot, $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},

        # ...
        salve =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if   ( int rand 2 == 0 ) { push @gijoe,  $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;else                     { push @barbie, $CHILD }
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;},

        # ...
    };

    #  make sure key exists, if not warn and move on to next $CHILD
    if ( not $CHILD or not exists $dispatch-&gt;{$CHILD} ) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;warn qq{Child not found!\n};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next;
&nbsp;&nbsp;&nbsp;&nbsp;}

    # call the CODE
    $dispatch-&gt;{$CHILD}-&gt;();
}

Santa was not happy with how this was going. He exclaimed in a panic, HASH keys are static strings! After taking some time to collect his thoughts, he knew what to do.

And that's when Santa took to https://metacpan.org, like always to search for a solution using the keyword, dispatch. And he found a module that looked promising, Dispatch::Fu.

This module promises that it converts any complicated conditional dispatch situation into familiar static hash-key based dispatch. And that's exactly what Santa needed.

In a jiffy, he was able to whip out a solution that was really looking much nicer.

use strict;
use warnings;
use Dispatch::Fu;

my (@teddybear,    @rockinghorse,
&nbsp;&nbsp;&nbsp;&nbsp;@jackinthebox, @gijoe,
&nbsp;&nbsp;&nbsp;&nbsp;@barbie,       @sallytalksalot,
&nbsp;&nbsp;&nbsp;&nbsp;@teaset,       @dollhouse);

sub get_child() {
&nbsp;&nbsp;qw/al grant mary salve/; # e.g., ...
};

foreach my $CHILD ( get_child() ) {
&nbsp;&nbsp;dispatch {
&nbsp;&nbsp;&nbsp;&nbsp;my $_CHILD = shift;
&nbsp;&nbsp;&nbsp;&nbsp;return q{A_F} if ($CHILD =~ m/^[a-fA-F]/);
&nbsp;&nbsp;&nbsp;&nbsp;return q{G_L} if ($CHILD =~ m/^[g-lG-L]/);
&nbsp;&nbsp;&nbsp;&nbsp;return q{M_R} if ($CHILD =~ m/^[m-rM-R]/);
&nbsp;&nbsp;&nbsp;&nbsp;return q{S_Z} if ($CHILD =~ m/^[s-zS-Z]/);
&nbsp;&nbsp;} $CHILD,
&nbsp;&nbsp;&nbsp;&nbsp;on A_F =&gt; sub {if (int rand 2 == 0) { ... }},
&nbsp;&nbsp;&nbsp;&nbsp;on G_L =&gt; sub {if (int rand 2 == 0) { ... }},
&nbsp;&nbsp;&nbsp;&nbsp;on M_R =&gt; sub {if (int rand 2 == 0) { ... }},
&nbsp;&nbsp;&nbsp;&nbsp;on S_Z =&gt; sub {if (int rand 2 == 0) { ... }};
}

One last thing had to be addressed - add the coin flip as another case represented by a hash key. Once done, Santa was very pleased to present the following code to his main code reviewer and QA, Mrs. Clause.

use strict;
use warnings;
use Dispatch::Fu;

my (@teddybear,    @rockinghorse,
&nbsp;&nbsp;&nbsp;&nbsp;@jackinthebox, @gijoe,
&nbsp;&nbsp;&nbsp;&nbsp;@barbie,       @sallytalksalot,
&nbsp;&nbsp;&nbsp;&nbsp;@teaset,       @dollhouse);

sub get_child() {
&nbsp;&nbsp;qw/al grant mary salve/; # e.g., ...
};

foreach my $CHILD ( get_child() ) {
&nbsp;&nbsp;dispatch {
&nbsp;&nbsp;&nbsp;&nbsp;my $_CHILD   = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $coinflip = int rand 2;
&nbsp;&nbsp;&nbsp;&nbsp;return q{A_F_0} if ($_CHILD =~ m/^[a-fA-F]/ and $coinflip == 0);
&nbsp;&nbsp;&nbsp;&nbsp;return q{A_F_1} if ($_CHILD =~ m/^[a-fA-F]/ and $coinflip == 1);
&nbsp;&nbsp;&nbsp;&nbsp;return q{G_L_0} if ($_CHILD =~ m/^[g-lG-L]/ and $coinflip == 0);
&nbsp;&nbsp;&nbsp;&nbsp;return q{G_L_1} if ($_CHILD =~ m/^[g-lG-L]/ and $coinflip == 1);
&nbsp;&nbsp;&nbsp;&nbsp;return q{M_R_0} if ($_CHILD =~ m/^[m-rM-R]/ and $coinflip == 0);
&nbsp;&nbsp;&nbsp;&nbsp;return q{M_R_1} if ($_CHILD =~ m/^[m-rM-R]/ and $coinflip == 1);
&nbsp;&nbsp;&nbsp;&nbsp;return q{S_Z_0} if ($_CHILD =~ m/^[s-zS-Z]/ and $coinflip == 0);
&nbsp;&nbsp;&nbsp;&nbsp;return q{S_Z_1} if ($_CHILD =~ m/^[s-zS-Z]/ and $coinflip == 1);
&nbsp;&nbsp;} $CHILD,
&nbsp;&nbsp;&nbsp;&nbsp;on A_F_0 =&gt; sub { push @teddybear,      shift },
&nbsp;&nbsp;&nbsp;&nbsp;on A_F_1 =&gt; sub { push @dollhouse,      shift },
&nbsp;&nbsp;&nbsp;&nbsp;on G_L_0 =&gt; sub { push @rockinghorse,   shift },
&nbsp;&nbsp;&nbsp;&nbsp;on G_L_1 =&gt; sub { push @teaset,         shift },
&nbsp;&nbsp;&nbsp;&nbsp;on M_R_0 =&gt; sub { push @jackinthebox,   shift },
&nbsp;&nbsp;&nbsp;&nbsp;on M_R_1 =&gt; sub { push @sallytalksalot, shift },
&nbsp;&nbsp;&nbsp;&nbsp;on S_Z_0 =&gt; sub { push @gijoe,          shift },
&nbsp;&nbsp;&nbsp;&nbsp;on S_Z_1 =&gt; sub { push @barbie,         shift };
}

Santa also knew that even if Mrs. Clause didn't like the way he used a bunch of inline returns and repeated some regular expressions, he was more than content knowing the tried and true, pull requests accepted! applied here for her as much as it did for anyone else!

See More:

https://metacpan.org/pod/Dispatch::Fu
https://blogs.perl.org/users/oodler_577/2023/09/cgitiny-dispatchfu---nearly-a-perfect-match.html

My Top 7 Perl New Features

2023-12-12T00:00:00Z

For each version of Perl, I update my book Perl New Features. Perl v5.10 has a big change in perl development where we started to get new syntax instead of making old syntax adapt to the new world (like making things Unicode).

There are so many features that I could choose from, but I looked back at those I've been using for the past year, and which ones I'd fight for in a code review. These aren't the most clever or groundbreaking features, but they are the ones that I'm consistently using.

0. Subroutine signatures

Perl v5.20 added experimental signature support, and v5.36 moves these out of experimental status:

use v5.36;

sub do_it {
&nbsp;&nbsp;&nbsp;&nbsp;my( $name, $cost, $age, $limit ) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;...
}

It seems like a slight change, but moving the names for the arguments outside of the braces makes everything much tidier:

use v5.36;

sub do_it ( $name, $cost, $age, $limit ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

Some of these can have default values (all required values must come first):

use v5.36;

sub do_it ( $name, $cost, $where, $limit = 5 ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

do_it( 'brian', 3, 'NYC' ); # limit is the default

And, Perl v5.38 lets me use the defined-or to set default values when I use undef for a placeholder:

use v5.38;

sub do_it ( $name, $cost, $where //= 'NYC', $limit = 5 ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

do_it( 'brian', 3, 'NYC' ); # limit is the default

do_it( 'brian', 3, undef, 7 ); # where is the default

Eventually, signatures will turn off @_ inside the braces, which has been annoying, but if that's the trade-off for signatures, so be it.

1. Substitution returns a copy.

Perl v5.14 added the the r flag for the substitution operator. When I use that, the bound string is unmodified but I get the modified version with the replacement:

my $modified = $original =~ s/PATTERN/REPLACEMENT/r;

This is especially handy in a map, where I have often made the mistake of transforming @original into a list of 1s or empty strings:

my @modified = map { s/PATTERN/REPLACEMENT/r } @original;

2. Postfix dereference

Perl's generalized dereferencing is a circumfix operator, which is a fancy way of saying that I have to type on both sides of the reference:

	# @{ REFERENCE }
&nbsp;# @{ $hash{$key} }

foreach my $item ( @{ $hash{$key} } ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

Perl v5.20 added the postfix dereference feature, and Perl v5.24 stabilized it:

use v5.24;

foreach my $item ( $hash{$key}-&gt;@* ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

3. The infix isa

Checking that a Perl object was of a particular class, or a subclass or that, was a pain. There's isa from UNIVERSAL, but that only works if you have an object. I do this quite a bit in testing Perl code, and since it might blow up, I have to wrap that in an eval:

if( eval { $obj-&gt;isa($target_class) } ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

Perl v5.32 introduced the infix version of isa that can return false if the left-hand side is not an object. This is much more pleasing:

if( $obj isa $target_class ) {
&nbsp;&nbsp;&nbsp;&nbsp;...
}

Someday we might get infix operators for can and does.

4. Key-value slices

I'm a big fan of slices, but for a long time (since forever), Perl didn't have a way to slice a hash and get a hash back. For example, I want a sub-hash that I can use a map. I've typed out something like this so often I don't even feel the pain anymore:

my %slice = map { $_ =&gt; $hash{$_} } @wanted_keys;

Perl v5.20 introduced "key-value" slices. I know it's a key-value slice because I see the % in front of hash:

use v5.20;
my %key_value_slice = %hash{@wanted_keys};

A hash slice with @ gives you back only the values:

my @value_slice = @hash{@wanted_keys};

In the last year I'm been particularly keen to clean up areas where I'm passing around too much data. Instead of using a "god" hash with lots of irrelevant keys, I extract just the parts I need so that nothing gets more than it should be allowed to use:

use v5.20;
my %sub_hash = %hash{@wanted_keys};
some_function( \%sub_hash );

If I'm really concerned about something changing something they shouldn't, I might make a deep copy:

use v5.20;
use Storable;

my %sub_hash = %hash{@wanted_keys};
my $clone = Storable::dclone( \%sub_hash );
some_function( $sub_hash );

5. Initialize hashes and arrays with state

I absolutely love state and I try to put everything that matters to a subroutine inside its lexical scope. This makes it easy to move the entire subroutine and everything it needs to another place in the file, or even another file.

And, while I'm very comfortable with references, if I can leave out all the dereferencing arrows, ->, I will. When Perl v5.10 added state, it could only initialize scalars. This wasn't a big deal with anonymous arrays, it feels clunky with a hash because I often want to construct the hash to check existence of some allowed value:

sub do_it {
&nbsp;&nbsp;&nbsp;&nbsp;state $scalar = 137;
&nbsp;&nbsp;&nbsp;&nbsp;state $array = [ 1, 3, 7 ];
&nbsp;&nbsp;&nbsp;&nbsp;state $hash = { map { $_, 1 } (1, 3, 7) };

&nbsp;&nbsp;&nbsp;&nbsp;if( exists $hash-&gt;{$args[0]} ) { ... }
}

With v5.28, I can initialize array and hash variables in state:

sub do_it {
&nbsp;&nbsp;&nbsp;&nbsp;state $scalar = 137;
&nbsp;&nbsp;&nbsp;&nbsp;state @array = qw( 1, 3, 7 );
&nbsp;&nbsp;&nbsp;&nbsp;state %hash = map { $_, 1 } (1, 3, 7);

&nbsp;&nbsp;&nbsp;&nbsp;if( exists $hash{$args[0]} ) { ... } # leave off the -&gt;
}

6. Indented here docs

I love heredocs for multi-line strings, and up to Perl v5.26 you either had to start each line at the left margin, or do clunky post-processing to remove leading whitespace:

if( ... ) {
&nbsp;&nbsp;&nbsp;&nbsp;my $string = &lt;&lt;'HERE';
This string is flush left!
Here's another line!
This is insane!
HERE

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

With Perl v5.26, Perl can strip leading whitespace for you, up to the whitespace ahead of the closing delimiter (HERE in this example). Now my heredocs don't have to screw up my indention:

if( ... ) {
&nbsp;&nbsp;&nbsp;&nbsp;my $string = &lt;&lt;~'HERE';
        This string is outdented!
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Here's another line!
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;This is nicer!
        HERE

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

Santa's Helpers' Helpers

2023-12-11T00:00:00Z

In past years, Santa really was that jolly old soul everyone talks about, but for the last several months, the old boy has been roaring at his staff in frustration.

"Eight billion souls on earth now! How am I to keep my lists? The old ways just aren't working any more! I can't tell who's been naughty, and who's been nice!"

Midyear, he finally called a meeting of the entire North Pole team, elves and reindeer both. Mrs. Claus baked up a massive batch of cookies, and called the meeting to order. "Now, listen up, all of you! As you know, Santa has been in quite a state this year. The population of Earth hit 8 billion last November, and all those babies born since are automatically on the good list for their first year. But keeping up with the older children and adults has gotten to be quite the burden. He's driving me crazy, stomping around the house with those long lists dragging around behind him. So everyone, put your thinking caps on. We need innovation, now!"

The North Pole's CEO stood up, shuffled some papers on the lectern in front of him, and said, "folks, I owe you all an apology. I've been a grumpy old jerk all year, with my job overwhelming me at last. Mrs. Claus and I have spent some time talking, and she's convinced me to ask you all for your help. We need a better way to keep up with the lists of naughty and nice children and adults on earth. Don't worry about what it'll cost, I'll take care of that. But it needs to be fast, flexible, and easy for us to keep up with. If there are some bits of it that we can automate, so much the better. Does anyone have an idea we can use?"

About halfway to the back sat an elf named Otto, wearing thick glasses, and a pocket protector. He was a builder of the geeky electronic toys that had become so popular in the last thirty or forty years. He raised his hand, and when Santa called on him, he said, "Sir, if we can get a big enough computer, we could put all of them in a database. Some of us could write a program to help you manage it on your web browser."

"Elf Otto, that's a fine idea! Come up here and let's work on that. Anyone else knowledgeable in these things, please come down front to help. The rest of you, get cracking on those toy orders!"

The new North Pole Application Group, as they dubbed themselves, quickly decided to build Santa's new database manager with Perl, using Dancer2, DBIx::Class, and PostgreSQL, finding them quick and easy to use, and scalable to the size that the boss-man needed. A couple of clever elves worked with Santa to find a place to host their new application, another small group started working on the UI, a couple of grumpy older elves took up the job of testing, and Otto found himself leading a team to design the database schema, and give the UI team the tools they needed to access it.

"DBIx::Class is massive! By itself, it can do everything we need!" one member of the team exclaimed, after reading just some of the documentation.

"Yes, sure, it can," Otto told him, "but some of it is pretty darn arcane. We need helpers."

The room erupted. "But *we* are Santa's helpers!" one shouted.

"Fine, fine, yes, we are," Otto said, after calming the team. "But sometimes helpers need helpers. This is a big, big tool we're building, and we want the UI and testing teams to be able to use our part of it very easily, with code they can read and understand and maintain in the future. The database is the core of the application, so it's gotta be easy to work with. Call these Santa's-Helpers-Helpers if you want. But DBIx::Class has a lot of helpers available on CPAN. Let's look for a few that can make things easier to work with for the other teams."

And so they did. Here are a few that they found:

Test::DBIx::Class

The grumpy testing elves found this module very useful; it let them set up and run unit and integration tests in a known-clean environment. They designed the test fixtures and wrote tests to make sure every function behaved as it was supposed to.

Dancer2::Plugin::DBIx::Class and DBIx::Class::ResultSetNames

These two modules gave the elves easy access to all the tables of the database. Instead of typing long references to the name of the table to start a search, they just start it with the name of the table. Searches are quick and semantically friendly:

$schema-&gt;resultset('Person')-&gt;search({ ... });   # no need for this...
db_person-&gt;search({...})                         # when you can do this.

DBIx::Class::TemporalRelations

Elf Wayne used this module to write a daily cron job for the application that would update the children older than one year, so Santa could start watching their naughty/nice ratio. The heart of it lay in a single line of code:

db_person-&gt;born_before($dt_1_year_ago)-&gt;update({ auto_nice =&gt; 0 });

DBIx::Class::Helpers and DBIx::Class::MoreHelpers

The elves found all sorts of useful search shortcuts in these two modules, like rows() to limit the number of rows in a search for paging, and group_by() and order_by() which were handy for Santa's reports. is(), is_not(), and is_any() came in very handy for boolean fields, too.

DBIx::Class::Numeric

Elf Cynthia squealed with joy when she found this module on CPAN. She was working on the part of the application that would tally up the naughty and nice things that people do during the year. She discovered that once she declared a database field as numeric, she got baked-in methods to increment and decrement counters, increase or decrease counts, and even set boundary limits on them.

Not too much later, Santa's helpers launched V1.0 of eSanta, the application for the North Pole to keep track of Santa's naughty and nice lists. Santa smiled happily as he watched data being entered from his lists automatically. Mrs. Claus was thrilled, too, as Santa would be less grumpy and have more time to spend with her.

In the small workshop the eSanta team had set up with nice laptops, a ping-pong table, and whiteboards covering the walls, work on V2.0 is already well underway. That version will include new features to help Santa in his fall field-work sessions, when he goes to malls and stores and parades and talks to the children about what they want for Christmas. It includes a module for the North Pole Post Office to enter data from Santa's letters, too, though the now-jolly fellow insists that he must still read each and every one. As the data is entered, it'll be piped down to Santa's workshops so that the elves could build the toys to fulfil those orders, and have the bundles of toys ready for Santa's whirlwind delivery on December 25th!

Introduction to App::Timer

2023-12-10T00:00:00Z

Background

So what is it that I am going to talk about today?

As you all know I have handful of distributions available on MetaCPAN. Although I am not actively managing any of them but I do look after them as and when needed.

If you look at the list of my distributions, you would notice that some of them are just plain application i.e. something that can be executed at the command prompt. One of them, e.g. App::calendr. Every time, I run an application, I always wanted to know how long it took to complete the execution.

For many years, I used to add the following snippets at the end of my command line application script.

END {
&nbsp;&nbsp;&nbsp;&nbsp;my $time = time - $^T;
&nbsp;&nbsp;&nbsp;&nbsp;my $mm   = $time / 60;
&nbsp;&nbsp;&nbsp;&nbsp;my $ss   = $time % 60;
&nbsp;&nbsp;&nbsp;&nbsp;my $hh   = $mm / 60;

&nbsp;&nbsp;&nbsp;&nbsp;printf(&quot;The program ran for %02d:%02d:%02d.\n&quot;, $hh, $mm%60, $ss);
}

Proposals

Can I do something that works for every command line applications?

Well, I gave a deep thought one weekend and ended up quick and dirty solution, App::Timer.

To be honest, there is no Rocket Science behind it. However it is very handy and help me with all my command line applications.

There are 2 ways you can have the timer added to your application.

Import the module

You can simply add one line use App::Timer at the top and you are done.

Command line switch

Not always you want to touch the application source code, so you can use the command line switch instead as below:

    $ perl -MApp::Timer your-application.pl

Perl being the Perl, you can get away not doing any of the above and simply do this:

    $ time perl your-application.pl

If you use App::Timer, you can expect the command line output to look something like this:

    $ perl -MApp::Timer -E &#39;sleep 1&#39;
    The program ran for 00:00:01.

That's it for today, have an enjoyable holiday break.

Mooish Attribute Shortcuts For Everyone!

2023-12-09T00:00:00Z

Most of us surely know Moose. It is a solid piece of Perl software powering a lot of modern Perl code. It allows for very expressive definition of object attributes. This expresiveness comes at a cost, nicely explained by Curtis "Ovid" Poe in his blog post. In short: it is not immediately obvious what is the purpose of an attribute and you have to look at the option list to get the idea. In addition to that, the attributes become very verbose if you want to nail their behavior exactly right.

To solve this, you just install MooseX::Extended and enjoy new param and field, right? Sort of... The module does a lot of things, has a lot of dependencies and only works with Moose. If you often use Moo instead of Moose, you will have to find a Moo-specific module for this, and the API will likely be different.

This is the exact issue solved by Mooish::AttributeBuilder. It is a zero-dependency, module-agnostic helper for Moose family of modules letting you build your attributes more easily and give them meaning. It's not by any means a replacement of MooseX::Extended. On the contrary - it focuses on a very narrow scope of features and strives to deliver them for every Moose-compatible module on CPAN.

Let's look at a small example:

package Christmas::Tree;

use v5.38;
use Moose;
use Mooish::AttributeBuilder;
use Types::Common -types;

has param 'height' =&gt; (
&nbsp;&nbsp;isa =&gt; PositiveInt,
);

has field 'ornaments' =&gt; (
&nbsp;&nbsp;isa =&gt; ArrayRef[Str],
&nbsp;&nbsp;predicate =&gt; 1,
&nbsp;&nbsp;lazy =&gt; sub { [] },
);

The above code will have the same effect as the following vanilla Moose code:

package Christmas::Tree;

use v5.38;
use Moose;
use Types::Common -types;

has 'height' =&gt; (
&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;isa =&gt; PositiveInt,
&nbsp;&nbsp;required =&gt; 1,
);

has 'ornaments' =&gt; (
&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;isa =&gt; ArrayRef[Str],
&nbsp;&nbsp;predicate =&gt; 'has_ornaments',
&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;default =&gt; sub { [] },
&nbsp;&nbsp;init_arg =&gt; undef,
);

After importing the module you automatically get four new keywords: param, option, field and extended. param and option attributes will be available in the constructor, the first one being required and the second one optional (with a handy predicate). field attributes are not assignable in the constructor and force no other behavior. extended is used for extending parent attributes. No matter which you use, you always get is => 'ro' for free.

Each keyword is used in conjunction with has. You put the keyword between has and the options, and the option list will be altered to contain the target values. There is no magic of replacing has for each and every module, which makes it very transparent.

The module is made to work with any module compatible with core Moose. The option lists it produces should therefore be valid for Moose, Moo, Mouse, Mo, Mite and possibly others.

In addition to controlling the constructor behavior, it contains some shortcuts which may come in handy. We've already seen how lazy => sub { [] } became lazy => 1, default => sub { [] }. It can also reduce boilerplate with isa + coerce combination, letting you write coerce => Type, and allow for previously incorrect trigger => 'method_name'. In addition, predicate => 1 became predicate => 'has_ornaments', which is a common shortcut delivered by MooseX::AttributeShortcuts (for Moose). If you used -hidden instead of 1, the generated name would be '_has_ornaments'. Specifying 1 uses the same visibility setting as the attribute, so if the attribute name was '_ornaments' then the method name would be '_has_ornaments' without the need for -hidden. Forcing public visibility on hidden attributes is achieved with -public. The module tries pretty hard to do what you mean, but it tries equally hard not to do more than that. The full list of shortcuts is available in "SHORTCUTS" in Mooish::AttributeBuilder.

Here are additional examples showcasing the behavior:

# this:

has field '_presents' =&gt; (
&nbsp;&nbsp;coerce =&gt; PresentType,
&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;clearer =&gt; -public,
);

# becomes:

has '_presents' =&gt; (
&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;isa =&gt; PresentType,
&nbsp;&nbsp;coerce =&gt; 1,
&nbsp;&nbsp;builder =&gt; '_build_presents',
&nbsp;&nbsp;lazy =&gt; 1,
&nbsp;&nbsp;clearer =&gt; 'clear_presents',
&nbsp;&nbsp;init_arg =&gt; undef,
);

# this:

has option 'favourite_color' =&gt; (
&nbsp;&nbsp;isa =&gt; Str,
&nbsp;&nbsp;trigger =&gt; 1,
);

# becomes:

has 'favourite_color' =&gt; (
&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;isa =&gt; Str,
&nbsp;&nbsp;trigger =&gt; sub { shift-&gt;_trigger_favourite_color(@_) },
&nbsp;&nbsp;predicate =&gt; 'has_favourite_color',
&nbsp;&nbsp;required =&gt; 0,
);

# and this:

has extended 'parent_attribute' =&gt; (
&nbsp;&nbsp;writer =&gt; -hidden,
);

# becomes:

has '+parent_attribute' =&gt; (
&nbsp;&nbsp;writer =&gt; '_set_parent_attribute',
);

The module delivers some additional features, the main one being custom shortcuts, but the core functionality alone should immensely improve the code quality. You immediately know what's what, and you will never overlook that pesky init_arg => undef again, no matter which Moose you use! So what do you say, worth giving a try?

Happy Holidays!

Who's That Clicking At The Window?

2023-12-08T00:00:00Z

Life at the Grotto has finally joined the modern age. Santa has got a new Laptop. The clacketty clack of his previous rather large steam powered workstation, a keyboard and a green phosphor terminal, replaced by a sleek portable device that could easily be carried on the sleigh. But some of the elves were mystified.

"Errr, what can you do with it?" asked Shinny Upatree, the aging elf.

"Look, " said Sugarplum eagerly,"Its looks so pretty, and you can move this arrow everywhere!",

Shinny was not convinced.

"I can even search for cute cat pictures",

Shinny knew all about gimmicks, "So what can you do that we NEED to do?",

"You can open up a terminal, and all our old software will work like before, I can even make the characters green", said Sugarplum desperately trying to make a case for new technology, "You can even use Notepad to write stuff"

Santa was passing by in a hurry, and overheard the conversation. "Of course, I have not got this new device just to still do things the old ways" he said, "I want a GUI", as he rushed by on his high performance electric scooter.

"Is that as messy as it sounds?" asked Shinny.

"Yes," groaned Sugarplum, "There are many GUI frameworks, it takes time to learn, and unlike terminal applications we are used to, a GUI application compiled for Santa's PC may not work on your Linux machines without significant effort."

"Alabaster Elf would know, but he is on leave!",

"Creating windows, positioning buttons, text entry widgets, drop down boxes, making menus, calling up dialog boxes, file selectors, callbacks,...oh how are we going to manage?"

Sugarplum had her head in her hands as Santa whizzed back again. "You can use Notepad?"

"That's about all I can do," she sniffled, "and Shinny can use vim on a terminal.",

"Then try GUIDeFATE", said Santa, "It stands for GUI Design From A Text Editor",

"Using GUIDeFATE, you simply draw the window and the widgets using ASCII characters in monospace fonts," he continued, "with a few easy-to-learn patterns to define widgets."

Ordinary text are "Static Text" items in the window
Buttons are enclosed in curly braces e.g. {Submit}
Inputs are in square braces e.g.[Default value]
Drop down boxes are in carets (not carrots) e.g.^ListName^
Images and Text Panels at drawn boxes with "I" ar or "T" in the top line

Half an hour later, after installing Tk and force installing GUIDeFATE Sugarplum Mary had already the following code:

#!/usr/bin/env perl
# A database for Santa

use strict;
use warnings;
use GUIDeFATE;

my $window=&lt;&lt;END;
+-------------------------------------------+
|T The Everybody Database                   |
+M------------------------------------------+
|  Making A List, Checking it twice         |
|  Gonna find out Who's naughty and nice    |
|                                           |
|  {&lt;} Person Index {&gt;}  [Name         ]{?} |
|  +T-----------------+  +I--------------+  |
|  |Address           |  | Avatar.png    |  |
|  |                  |  |               |  |
|  |                  |  |               |  |
|  +------------------+  +---------------+  |
|  ^NiceOrNaughty     ^  [Present        ]  |
|  [Chimney Access Notes                 ]  |
|     {New}{Update}{Delete}{Read Letter}    |
|     Person 00000000001 of 8,342,124,422   |
|                                           |
+-------------------------------------------+

NiceOrNaughty=Nice,Naughty

END

my $backend=&quot;tk&quot;;                 # one of gtk, tk, gtk3, wx, win32 or html
my $assist=&quot;a&quot;;                   # a for autogenerate, v for verbose, q for quiet
my $gui=GUIDeFATE-&gt;new($window,$backend,$assist); # Create the interface
my $frame=$gui-&gt;getFrame()||$gui; # $frame object now contains all the widgets
$gui-&gt;MainLoop();                 # start the GUI

Executing this script yielded the following UIs with GTK, TK, HTML and Wx, effectively 17 "widgets" in less than 10 instructions.

But Santas laptop ran Windows. The solution was thankfully simple. Install Win32::GUI and Imager on Santas laptop, and change the $backend variable to "win32".

Making a UI was one thing, but tying actions to the widgets is quite another. How would you code the functions triggered by user interactions with the interface? Well passing "a" (for autogenerate) as the $assist parameter, makes GUIDeFATE to create a text file with all the detected widgets as well as the skeleton functions that represent the callbacks. This is only required once, and the assist can be switched off by reverting to "q", afterwards to prevent generating this file at every execution.

With the above UI it generates the following file:

#Static text 'Making A List, Checking it twice'  with id stattext0
#Static text 'Gonna find out Who's naughty and nice'  with id stattext1
sub btn2 {#called using button with label &lt;
  # subroutine code goes here
   };

sub btn3 {#called using button with label &gt;
  # subroutine code goes here
   };

sub btn4 {#called using button with label ?
  # subroutine code goes here
   };

sub textctrl5 {#called using Text Control with default text ' Name          '
  # subroutine code goes here
   };

#Static text 'Person Index'  with id stattext6
#Static text '|'  with id stattext7
#SubPanel 'T' Id 9 found position  3 height 5 width 18 at row 5 with content Address
#SubPanel 'I' Id 11 found position  25 height 5 width 15 at row 5 with content Avatar.png
#Static text '|'  with id stattext12
sub combo13 {#called using combobox with data from @NiceOrNaughty
  # subroutine code goes here
   };

sub textctrl14 {#called using Text Control with default text ' Present         '
  # subroutine code goes here
   };

sub textctrl15 {#called using Text Control with default text ' Chimney Access Notes                  '
  # subroutine code goes here
   };

sub btn16 {#called using button with label New
  # subroutine code goes here
   };

sub btn17 {#called using button with label Update
  # subroutine code goes here
   };

sub btn18 {#called using button with label Delete
  # subroutine code goes here
   };

sub btn19 {#called using button with label Read Letter
  # subroutine code goes here
   };

#Static text 'Person 00000000001 of 8,342,124,422'  with id stattext20

Each item in the window can be accessed using the id. Each button click or input change triggers a subroutine. Static Texts can be changed by using their IDs.

More information can be found at GUIDEFATE's Github Pages

This was a quick and dirty solution to creating a general purpose intuitive UI; something that young Alabaster, the elf with advanced graphical interface powers could easily beautify once he returns from his well earned rest.

HTML/XSS scrubbing and file upload validation in Catalyst

2023-12-07T00:00:00Z

At work, we needed to tighten up the security of our Catalyst-powered API, with two main requirements:

Stripping HTML/XSS attempts from incoming parameters
Validating that file uploads are expected and are the expected type

Catalyst::Plugin::HTML::Scrubber

We found Catalyst::Plugin::HTML::Scrubber, which at first glance looked like it would do at least most of what we needed, automatically scrubbing parameters using HTML::Scrubber.

We're not a fan of reinventing wheels when we can avoid it, so I set about adding the extra features we needed - in particular, being able to exempt particular parameters from scrubbing, by name or regex match - and raised a pull request to share that upstream. Unfortunately, the original author doesn't seem to be active in the Perl community any more, and several attempts of contact failed - so I followed the usual steps to adopt a module, approaching our friendly CPAN admins for help, obtained co-maint, and released a new version.

Since then we added more - including recursive scrubbing of parameters within serialised POSTed/PUTted request bodies.

Catalyst::Plugin::CheckFileUploadTypes

Next, we needed to add checking of uploaded files. Some API actions do expect uploaded files, but most don't. We wanted to make it easy to centralise that checking so that if an action hasn't specified that it expects file uploads, any attempts to upload files in requests sent to it should be rejected.

It should also be easy for the action to denote which MIME types it expects to receive, without lots of boilerplate code being added to each action.

Naturally you'd want to use something to determine the type of file you were actually sent and can't just trust the Content-Type header in the request, because the client could lie to us.

We didn't find anything that fitted our needs, so I created Catalyst::Plugin::CheckFileUploadTypes, using subroutine attributes on the actions to mark that they expect uploads, for instance:

use Catalyst qw(CheckFileUploadTypes);

# Actions can declare that they expect to receive file uploads:
sub upload_file : Local ExpectUploads { ... }

# They can also specify that any uploaded files must be of expected types
# (determined from file content by File::MMagic, not what the client said,
# as they could lie to us)
sub upload_file : Local ExpectUploads(image/jpeg image/png) { ... }

There was a little bit of fun involved if the app is using Catalyst::Action::REST, in which case we want to be looking for the attributes on the _type-suffixed action - for e.g. index_POST.

More features are planned (and may well have been implemented by the time you read this!) - including:

Wildcards: for e.g. the ability to say e.g. image/* for any type of image
Extra heuristics to distinguish more file types: For example, both a shell script and an XML file are both text/plain according to the underlying File::MMagic; that's not very helpful.
More options: More options to provide more control over how unexpected uploads are handled
Callbacks: Callbacks to fire for each uploaded file to perform additional checks on it - for example, running it through a virus checker, generating a hash and checking online services for matches, or other checks on the content of the file.

Feedback, suggestions and patches welcome!

Arango::Tango, the new mammal in town

2023-12-06T00:00:00Z

Introduction

Arango::Tango is not properly new, as the first versions are from 2019. Nevertheless, the number of users is still quite small as other document-oriented databases, like ElasticSearch or MongoDB are still quite popular. But being somehow alergic to Java, I went in the search for an alternative and found ArangoDB, a graph database (also able to deal with plain document collections) written in C++.

ArangoDB is a graph-oriented database, making it particularly well-suited for storing network structures such as social networks, knowledge graphs, and geospatial information. To achieve this, ArangoDB utilizes two collections: one for nodes and another for edges. The nodes collection functions as a standard database of documents, similar to what you would find in MongoDB. Meanwhile, the edges collection has documents containing two special attributes: the origin and target nodes, identified by their document identifiers. Unlike MongoDB and ElasticSearch, ArangoDB employs a specific Domain-Specific Language for queries. However, unlike the former two, ArangoDB's query language, named AQL (ArangoDB Query Language), is not based on JSON. This distinction makes AQL easier to write and understand.

When I found out about ArangoDB, I did not find a good Perl module to interact with it, so I decided to create one. Arango::Tango was born. It is, surely, the Perl module I own with a cuter name, with both a pun on dancing a Tango with Arango, but also with the similarity with orangutangus.

Quick and Dirty Arango::Tango

The ArangoDB insterface is based on REST, and the REST API is properly documented with Swagger. It should be possible to use any generator that, from a Swagger specification, generates an API. But, being REST, the API is stateless, and that does not help being proficient when using it. Thus, I created my own monster, that both tries to be versatile enough to allow quick implementation of new methods using a structure similar to a Swagger file, but also with an object-oriented approach, where each type of object we can manage in the ArangoDB database has a counterpart Perl object.

To give a quick example on how to create a ArangoDB collection and insert a couple of documents:

use Arango::Tango;

my $server = Arango::Tango-&gt;new( host     =&gt; '127.0.0.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;username =&gt; 'root',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;password =&gt; '123123123');

my $database = $server-&gt;create_database(&quot;database_name&quot;);
my $collection = $database-&gt;create_collection(&quot;collection_name&quot;);

my $document = { name =&gt; &quot;John&quot;, surname =&gt; &quot;Doe&quot; };
$collection-&gt;create_document( $document );

my $documents = [
&nbsp;&nbsp;&nbsp;&nbsp;{ _key =&gt; &quot;homer&quot;, name =&gt; &quot;Homer&quot;, surname =&gt; &quot;Simpson&quot; },
&nbsp;&nbsp;&nbsp;&nbsp;{ _key =&gt; &quot;marge&quot;, name =&gt; &quot;Marge&quot;, surname =&gt; &quot;Simpson&quot; }
];
$collection-&gt;bulk_import( $documents );

All the methods result in an HTTP request. But note that the objects created by Arango::Tango track the current database and collection. Thus, you do not need to pass that information everytime a new request is performed. You just create documents in the collection, and the module knows where the collection is (which database) and constructs properly the request.

The query of documents can be performed directly, if you know the document identifier:

my $document = $collection-&gt;document( &quot;lisa&quot; );  # retrieve document with key &quot;lisa&quot;

Usually one does not want to just fetch a document, but perform a complex query. For that we will need to use the ArangoDB's query language: AQL. The method's name to query a collection is not the more intuitive, as I followed the convention from the REST API. I may change that in the future. It is named cursor because it returns... a cursor object, that allows you to go through a set of results.

my $query = &lt;&lt;EOQ;
    FOR doc IN collection_name
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FILTER doc.surname == 'Simpson'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;RETURN doc
EOQ
my $cursor = $collection-&gt;cursor($query);
while ($cursor-&gt;has_more) {
&nbsp;&nbsp;&nbsp;&nbsp;my @block = $cursor-&gt;next();
    # do something with elements from @block
}

Note that, by default, ArangoDB returns more than one document when iterating a cursor, to make it more efficient. Thus, the next method returns a list of results and not just one item.

The Arango::Tango Guts

I am proud of the way this module has been designed. The code is not as polished as I would like it to be, but the idea behind it is quite interesting. I decided to give some insight into its implementation. Note this is just a quick glimpse of it. You are welcome to look into the code for more detail.

Each of the modules (database, collection, etc) start by running an initialization method. It is based on a structure that specifies the available REST API requests. This initialization generates methods with the required code to execute the REST request.

Two small examples for the Arango::Tango::Collection module:

load_indexes =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;rest =&gt; [ put =&gt; '{{database}}_api/collection/{name}/loadIndexesIntoMemory' ],
&nbsp;&nbsp;&nbsp;&nbsp;inject_properties =&gt; [ 'database', 'name' ],
},

rename =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;rest =&gt; [ put =&gt; '{{database}}_api/collection/{collection}/rename' ],
&nbsp;&nbsp;&nbsp;&nbsp;inject_properties =&gt; [ 'database', { prop =&gt; 'name', as =&gt; 'collection'  } ],
&nbsp;&nbsp;&nbsp;&nbsp;signature =&gt; [ 'name' ],
&nbsp;&nbsp;&nbsp;&nbsp;schema =&gt; { name =&gt; { type =&gt; 'string' }},
},

The top-level key is the name of the method to create. The value of the dictionary defines details on the method implementation:

For the load_indexes method, there is the REST template (that specifies the HTTP verb and the route template) and the inject_properties array. This array is a list of the parameters, in the REST template, that should be filled in from data in the collections object fields.
The rename method has the same two properties as the previous one. But the inject_properties is a little different. Basically, it has two fields from the object being injected in the template (the database and the collection name) but, for the collection, we specify that it is stored in the name field of the object, but will be referred to in the template as collection. This change is done because there is a parameter named name, and we need to disambiguate.

The signature field is the list of parameters that the method will receive and the schema property is the structure of the data that will be sent in the PUT request. Note that there is a name field in that data, that will come from the method's signature.

Unfortunately not all requests are as easy to generalize and therefore there is some extra code to deal with hairy calls. Also, there is a reason why the template has two curly braces for the database parameter. But that is not relevant for being discussed here.

If you found this interesting, I would appreciate your help on supporting more of the ArangoDB API!

Santa's Christmas Dancer2 Web App - Naughty & Nice List Manager

2023-12-05T00:00:00Z

Ho, ho, ho! In this hilarious Christmas-themed Dancer2 web app tutorial, we'll help Santa manage his Naughty & Nice list. This time, we're using Perl's Dancer2 framework, but Santa's Christmas spirit is universal. Let's dive in and create Santa's very own web app!

todo.pl

!#/usr/bin/env perl

use Dancer2;
set template =&gt; 'mustache';

# Initialize Santa's Naughty &amp; Nice List
# See next steps below for making list persistent with a Planetscale Database

my $list = { list =&gt; [] };

get '/' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;send_file '/index.html';
};

any '/delete' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $q = request-&gt;params;
&nbsp;&nbsp;&nbsp;&nbsp;my $index = 0;

    # Find the naughty or nice kid to remove
    $index++ until $list-&gt;{list}[$index]{task} eq $q-&gt;{task};
&nbsp;&nbsp;&nbsp;&nbsp;splice(@{$list-&gt;{list}}, $index, 1);

    # Display the updated list
    template 'list' =&gt; $list;
};

any '/add' =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;my $q = request-&gt;params;

    # Add a new kid to the list
    push @{$list-&gt;{list}}, $q;

    # Display the updated list
    template 'list' =&gt; $list;
};

any '/list' =&gt; sub {
    # Display the current list
    template 'list' =&gt; $list;
};

start;

Here's what Santa's Christmas Dancer2 web app does:

We set up our Dancer2 app with Mustache templates.
Santa initializes his Naughty & Nice List as an empty array of tasks.
When you visit the root URL /, it serves an index.html file. Make sure to create this HTML file for a nice, festive interface.
To delete a naughty or nice kid, we look for the kid's task in the list and remove them. Then, we display the updated list using the 'list' template.
To add a kid to the list, we take the kid's name from the request parameters, push them onto the list, and display the updated list using the 'list' template. List is freeform text. Eg "Nancy - Naughty - coal". See Next steps below to expand into multiple database fields
The /list route simply displays the current Naughty & Nice List.

Now, Santa can keep a digital record of all the good and naughty children, and you can help him manage it with this fun Dancer2 web app. Merry Christmas and happy coding! 🎅🎄🌟

public/index.html

    &lt;!DOCTYPE html&gt;
    &lt;html&gt;
     &lt;head&gt;
        &lt;title&gt;TODO app&lt;/title&gt;
        &lt;!-- Include the htmx.js library for AJAX interactions --&gt;
        &lt;script src=&quot;https://unpkg.com/htmx.org@1.9.6&quot;&gt;&lt;/script&gt;
        &lt;!-- Include a stylesheet (Water.css in dark mode) for styling --&gt;
        &lt;link rel=&quot;stylesheet&quot; href=&quot;https://cdn.jsdelivr.net/npm/water.css@2/out/dark.css&quot;&gt;
     &lt;/head&gt;
     &lt;body&gt;
        &lt;!-- Create a form for adding tasks --&gt;
        &lt;form hx-post=&quot;/add&quot; hx-target=&quot;#list&quot; hx-on::after-request=&quot;this.reset()&quot;&gt;
            &lt;fieldset&gt;
                &lt;!-- Input field for entering a task --&gt;
                &lt;input type=&quot;text&quot; name=&quot;task&quot; placeholder=&quot;enter task&quot; /&gt;
                &lt;!-- Button to submit the task --&gt;
                &lt;button type=&quot;submit&quot;&gt;Add Task&lt;/button&gt;
            &lt;/fieldset&gt;
        &lt;/form&gt;
        &lt;fieldset&gt;
            &lt;!-- Display the list of tasks here using AJAX --&gt;
            &lt;div id=&quot;list&quot; hx-get=&quot;/list&quot; hx-trigger=&quot;load&quot;&gt;&lt;/div&gt;
        &lt;/fieldset&gt;
     &lt;/body&gt;
    &lt;/html&gt;

This HTML code provides a simple web interface to add and view tasks. When a user adds a task, it's sent to the server using htmx via the hx-post attribute, and the response updates the task list on the page. Santa can now manage his Naughty & Nice list with a modern touch. Merry Christmas and happy coding! 🎅🎄🌟

The provided template uses htmx, a library for building modern web applications with HTML, to create a list of tasks with some interactive behavior. Let's break down the template step by step:

views/list.mustache

     &lt;ul&gt;
         {{#list}} &lt;!-- This is a loop that iterates through the &#39;list&#39; array --&gt;
             &lt;li hx-post=&quot;/delete&quot; hx-target=&quot;#list&quot; hx-vals=&#39;{&quot;task&quot;:&quot;{{task}}&quot;}&#39;&gt;{{task}}&lt;/li&gt;
             &lt;!-- For each item in &#39;list&#39;, create an &lt;li&gt; element --&gt;
             &lt;!-- &#39;hx-post&#39; specifies an HTTP POST request when this &lt;li&gt; element is clicked --&gt;
             &lt;!-- &#39;hx-target&#39; designates where the response will be placed (in this case, back into the list) --&gt;
             &lt;!-- &#39;hx-vals&#39; defines the data to send with the POST request --&gt;
             &lt;!-- The data consists of a key &quot;task&quot; with the value being the task name from the list --&gt;
             &lt;!-- The {{task}} within the hx-vals is a placeholder for the task name from the loop --&gt;
             {{task}}
             &lt;!-- Display the task name within the &lt;li&gt; element --&gt;
         {{/list}}
     &lt;/ul&gt;

Here's how this template works:

<ul>: This creates an unordered list where each task will be represented as a list item <li>
{{#list}}: and {{/list}}: These tags denote a loop that iterates through the 'list' array. For each item in the 'list', it performs the following operations.
<li>: This creates an <li> element for each task in the 'list'
hx-post="/delete": When an <li> element is clicked, htmx sends an HTTP POST request to the URL specified in the hx-post attribute. In this case, it's /delete, indicating a task deletion action.
hx-target="#list": This attribute specifies where the response of the HTTP POST request should be placed. In this example, it replaces the content of the element with the ID "list," effectively updating the list after a task is deleted.
hx-vals='{"task":"{{task}}"}': This attribute defines the data to send with the POST request. It includes a key "task" with a value equal to the task name. The {{task}} is a placeholder that gets replaced with the actual task name from the loop during execution.
{{task}}: Inside the <li> element, this placeholder displays the task name from the loop in the list item.

In summary, this template generates a list of tasks, and each task has a delete button. When a delete button is clicked, htmx sends a POST request to the server to delete the corresponding task and updates the list without requiring a full page refresh.

Next Steps

View this repo to see the Planetscale database and fly.io edge deploy. This works great on the free tier of both. https://github.com/perladvent/2023-todoapp

Trimming your holiday tree

2023-12-04T00:00:00Z

It's time to pull out your holiday decorations. If you are like me, you probably have a couple of new decorations to add to your collection.

Perl v5.36 has some new ornaments too. The new pragma builtin defines several new functions in Perl's core. I go through these in Perl New Features, but there's one I want to show you this holiday season.

Remove surrounding whitespace

Typically I get rid of the annoying whitespace with an inefficient global substitution that I can't make my fingers not type:

use v5.10;
my $dirty_string = '   Happy Holidays   ';
say &quot;Dirty:   &lt;$dirty_string&gt;&quot;;

$dirty_string =~ s/\A\s+|\s+\z//ug;
say &quot;Trimmed: &lt;$dirty_string&gt;&quot;;

That /u tells the substitution to use the Unicode rules, which means this also trims all the other whitespace that Unicode defines. I'm especially fond of that one after chasing down a bug caused by a someone using an en space (U+2002) instead of a regular space (likely from an export from layout software).

Or, more likely, I keep the original as is and make a copy with the /r flag from v5.14. This way I can log the original value later when I'm trying to figure out why some inputs don't work right (or someone is passing bad data):

use v5.26;
my $dirty_string = '   Happy Holidays   ';
my $trimmed = $dirty_string =~ s/\A\s+|\s+\z//ugr;

say &lt;&lt;~&quot;HERE&quot;;
	Dirty:   &lt;$dirty_string&gt;
&nbsp;Trimmed: &lt;$trimmed&gt;
	HERE

This is such a common operation that it deserves its own name— trim. The builtin pragma is still experimental, so I turn off those warnings with experimental before I enable trim:

use v5.36;
use experimental qw(builtin);
use builtin qw(trim);

my $dirty_string = '   Happy Holidays   ';
my $trimmed = trim($dirty_string);

say &lt;&lt;~&quot;HERE&quot;;
	Dirty:   &lt;$dirty_string&gt;
&nbsp;Trimmed: &lt;$trimmed&gt;
	HERE

All of these get you to the same output:

        Dirty:   &lt;   Happy Holidays   &gt;
        Trimmed: &lt;Happy Holidays&gt;

More ornaments

builtin provides other new ornaments. I give detailed examples of these in Perl New Features.

The blessed, refaddr, reftype, is_tainted (as tainted), is_weak (as isweak), weaken, and unweaked functions have so far been part of the Scalar::Util module. Now they are directly in core and do the same job.

The ceil and floor functions move from the heavyweight POSIX module directly into core.

More excitingly, builtin adds true and false: no more !!1 floating around your code confusing everyone. These "distinguished" booleans know that they are booleans rather than comparing themselves to Perl's idea of truthiness. These are useful for turning data into formats that have special keywords for those ideas, such as JSON's true or false. You can check if you have one these distinguished values with is_bool.

Along with that, builtin knows if something is a string or a number based on the last thing that happened to it. With created_as_number or created_as_string, you know if you need to create the JSON string value {"value": 137} or the JSON string value {"value": "137"}. This should work going the other way too. Eventually the various libraries will catch up to Perl so we don't have to do weird acrobatics to figure out what sort of value we are supposed to have.

There are a few other interesting features for you to discover in builtin, and I hope many of these lose their experimental status soon.

Santa tackles Bitcoin, part two

2023-12-03T00:00:00Z

It was a new day in Lapland! Well, sort of... it was still dark outside due to polar night, but our elf friend McJingles was well-rested and full of energy! Yesterday he learned all about how to make a transaction using Bitcoin::Crypto, but he forgot to prepare the private keys to be gifted by Santa. Elves may be very hard-working, but they are also forgetful!

He quickly came up with a plan: the private keys will probably be printed on lovely decorated Christmas gift cards. All he had to do is provide printable representations of the private keys and the other elves can do all the printing. McJingles decided it will for now be enough to print all the keys as those Wallet Import Format (WIF) things he had used before to get access to the initial 50 BTC. The standard output of the script can be redirected to a file with no additional effort.

use v5.36;
use Bitcoin::Crypto qw(btc_extprv);

# Ask for mnemonic and password. Keeping them in a file makes them much easier
# target for malware and hackers!
say 'Please provide the mnemonic and password, each in separate lines:';
my $mnemonic = readline STDIN;
my $password = readline STDIN;

# Remove the newline from readline
chomp $mnemonic;
chomp $password;

# recover a key from input
my $master_key = btc_extprv-&gt;from_mnemonic($mnemonic, $password);

# how many presents?
my $number_of_kids = 346;

# print all the keys in WIF format
foreach my $index (0 .. $number_of_kids - 1) {

  # same derivation scheme as before
  my $key = $master_key-&gt;derive_key_bip44(
&nbsp;&nbsp;&nbsp;&nbsp;purpose =&gt; 84,
&nbsp;&nbsp;&nbsp;&nbsp;account =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;index =&gt; $index,
&nbsp;&nbsp;)-&gt;get_basic_key;

  # print it to standard output
  say $key-&gt;to_wif;
}

This script was much more straightforward than the previous one! It was time to see if the key recovery worked:

        Please provide the mnemonic and password, each in separate lines:
        brown bulk hire culture capital hill trim turkey  gossip artefact door media argue basic execute slam minute try number daughter music gauge vocal wink
        Christmas
        L1pn6bRKUY1dMXg6XvURHNCrm9CDByFehQPHmnfTKQXCxRktUAqN
        L3dhFVe8BgjgGGbu2Rm72fcgyB3SgVZ2ee8fsoezSA47QxhDAng5
        L2TZEBZJ2yTb2JxcxbUippr3DBAkZopLFrXSGGZRRzfH78RFcTnj
        (...)

It worked indeed, but it was not yet clear whether the private keys were the correct ones. McJingles crafted a one-liner to test the first key he got:

        $ perl -MBitcoin::Crypto=btc_prv -e \
        &#39;print btc_prv-&gt;from_wif(&quot;L1pn6bRKUY1dMXg6XvURHNCrm9CDByFehQPHmnfTKQXCxRktUAqN&quot;)-&gt;get_public_key-&gt;get_address&#39;
        bc1qls9ffahaa5kezk0zvq2hh58nn6yfv8uehdq7dp

Something was wrong. That's not the address which was generated before! How is that possible? After thorough investigation McJingles found out he typed two spaces while providing the mnemonic for the program. A quick scan through Bitcoin::Crypto::Key::ExtPrivate's documentation has revealed that from_mnemonic method usage without the language argument is not only whitespace-sensitive but also doesn't check if the words exist in the dictionary. It is pretty unsafe to use it like that unless you nail it exactly right! He modified the script to add 'en' language as the last argument to from_mnemonic...

my $master_key = btc_extprv-&gt;from_mnemonic($mnemonic, $password, 'en');

... and then tried again, making the same mistake:

        Please provide the mnemonic and password, each in separate lines:
        brown bulk hire culture capital hill trim turkey  gossip artefact door media argue basic execute slam minute try number daughter music gauge vocal wink
        Christmas
        L4DrMfpZRp5P6szTGqWQHnYDBJaAwTRN8NHRkTM3Kc79U14wi5Li
        L3rpcJdvNynUCWWaQEEAXkS7FPpCrz1HnCiHT4VYcmm4oWct5Fd8
        KwzsywmntPwwnEMTbd9jw7wPjeM4PKx52KeSLU9cZ4o1Qx7AFyTD
        (...)

The output was different, but was it the right key this time?

        $ perl -MBitcoin::Crypto=btc_prv -e \
        &#39;print btc_prv-&gt;from_wif(&quot;L4DrMfpZRp5P6szTGqWQHnYDBJaAwTRN8NHRkTM3Kc79U14wi5Li&quot;)-&gt;get_public_key-&gt;get_address&#39;
        bc1qum6sd22rmsewwd75lzlynuve8wz0ah2uw2gltu

Yes, that's correct! This was the first address printed in the transaction dump yesterday. If he was able to obtain the same address then surely he will be able to move the coins. And so will the children! When they wake up in the morning and find the gift cards, they will have an option of keeping it or sweeping it. Sweeping is a function commonly found in mobile Bitcoin wallets and when used the coins will be transferred away to a different wallet. To spare the kids all the retyping of WIFs it's best to also provide a QR code, but that's a problem for another day (or another elf). If they don't sweep it the coins will still be spendable by Santa and his helpers, but it's safe to assume they would never steal a Christmas present back!

He ran the script again with output redirected to a file and e-mailed it to Santa. "Here Father Christmas, I made it!" - he typed in excitement. He added all the other elves as CC to the e-mail so they could start printing the gift cards. It was a job well done indeed.

Now the last question remains: will he remember to publish the transaction before the Silent Night? We are about to find out very, very soon.

Santa tackles Bitcoin, part one

2023-12-02T00:00:00Z

Santa is facing a new problem. Year after year, an increasing number of kids list Bitcoin as a thing they want to find under the Christmas Tree. This new trend comes much to the displeasure of the Kriss Kringle.

"This is outrageous!", he yelled in annoyance. "How can this thing even have value? Hasn't it died like five hundred times already? It's not even real!"

He started stroking his beard, thinking. His white moustache danced like waves on a beach as he tried to understand the new reality of 2023. If the good kids want it, then he must oblige. But how could something be left in someone's house if it isn't physical? He asked his most tech-savvy elf, McJingles, to research the subject.

McJingles is a hacker. He knows a bunch of programming languages but Perl is his favourite. He's a walking reference book for all things software. But Bitcoin? That's relatively new and not really something he paid attention to. Moreover, the nasty things he heard about it and the criminals has put him off a great deal. But to be tasked to research it from the Father Christmas himself? That's a completely new level of incentive!

So he searched the Web for the term, but most of what he got were rubbish price speculation articles. The Bitcoin wiki was of some help, but it was partially outdated. The Bitcoin Improvement Proposal documents were good, but a bit too specific for his level. So maybe books? He read Mastering Bitcoin by Andreas Antropolus, which gave him a nice insight into the technical side of Bitcoin. He pressed ahead with The Bitcoin Standard by Saifedean Ammous, which provided all the economic details he needed.

It quickly became obvious the new task couldn't be performed in the current modus operandi. The Elves were used to crafting everything themselves and often resorting to magic in their toy factory. They can't counterfeit Bitcoin - not because it's a bad thing to do, but rather because it's impossible. Even the strongest Elf Magic won't do. They could either try to mine it or obtain it by providing high quality goods and services on the market. Luckily, one of the elves remembered he had played with Bitcoin back in 2011 and still had the old hard drive, from which they were able to reclaim keys to 50 bitcoins, enough for a big juicy present for a lot of kids. The unspent transaction ID for their coins is a4e407ba6b54106e4bd209704666a2b541b9b03d04ef8cb779aafe18238744e1.

Now the next step was to split the big chunk of 50 bitcoins into smaller pieces. This means you need to create a transaction with one input (the unspent previous transaction output of 50 bitcoins) and N + 1 outputs (one output for each of N kids, plus an additional one for the change). Since Santa said the number N is well into the hundreds this year, crafting this transaction by hand in a wallet software was out of question and they needed some kind of programmable library. McJingles, being a Perl lover, decided to give the module Bitcoin::Crypto a go. He started a new script to create the transaction:

use v5.36;
use Bitcoin::Crypto qw(btc_prv btc_utxo);

# first, import the 50 BTC output from previous transaction hex
btc_utxo-&gt;extract([hex =&gt; '
&nbsp;&nbsp;010000000100000000000000000000
&nbsp;&nbsp;000000000000000000000000000000
&nbsp;&nbsp;00000000000000ffffffff07045285
&nbsp;&nbsp;021b0151ffffffff0100f2052a0100
&nbsp;&nbsp;000043410452b58be18046f78a0045
&nbsp;&nbsp;fe49df56387a03f994ba2ac7a26e17
&nbsp;&nbsp;f7d01dc6d346f1bed3979ad35d32a7
&nbsp;&nbsp;5bb625f6e521f75a1c5983d303ea04
&nbsp;&nbsp;bfb43c8b72203a68eeac00000000
']);

# second, import the private key to these BTC
my $priv = btc_prv-&gt;from_wif('&lt;SUPER SECRET KEY TO 50 BTC&gt;');

So far so good, but there were some decisions to be made before continuing. The old private key was in WIF, short for Wallet Import Format, which is only capable of holding a single private key. Now hundreds of private keys needed to be generated, and the most important one of them all would be the change address for the unspent BTC. You may just send back to the address you've taken from, but since it was the effectively obsolete P2PK (pay to public key) address they figured it was smarter to generate a new type of address and send there. McJingles decided to generate a new mnemonic phrase capable of providing as many private keys as needed:

use Bitcoin::Crypto qw(btc_extprv);
use Bitcoin::Crypto::Util qw(generate_mnemonic);

# generate a new random mnemonic with 256 bits of entropy
my $mnemonic = generate_mnemonic(256);
my $password = 'Christmas';

# create a new master master key from the mnemonic
my $master_key = btc_extprv-&gt;from_mnemonic($mnemonic, $password);

# instruct the user to backup the mnemonic
# (say function is a part of 5.36 version bundle)
say &quot;Your mnemonic is &lt;$mnemonic&gt;&quot;;
say &quot;and your password is &lt;$password&gt;&quot;;
say &quot;Back them up!&quot;;

Mnemonic phrases are sets of words which encode the wallet's entropy in a human (or elf!) readable way. In case of 256 bits, the mnemonic will contain 24 words. The optional password makes sure it's not that easy for anyone who gets the mnemonic to take hold of all the Bitcoin. It is a secondary security feature. McJingles knew it was best to store the mnemonic offline, for example written on paper.

The created $master_key can be used to derive many keys from it using Hierarchical Deterministic derivation schemes. The clever elf decided to use the most widely supported BIP44 scheme with purpose 84. By using this purpose number, Segregated Witness addresses were created. It's a modern type of address which makes the on-chain fees lower.

# cuz Santa said so
my $number_of_kids = 346;

# get the master key for the BIP44 account with purpose 84
my $account_key = $master_key-&gt;derive_key_bip44(
&nbsp;&nbsp;purpose =&gt; 84,
&nbsp;&nbsp;get_account =&gt; !!1,
&nbsp;&nbsp;account =&gt; 0, # to be bumped up next Christmas!
);

# get the basic private key for the unused coins
my $change_key = $account_key-&gt;derive_key_bip44(
&nbsp;&nbsp;get_from_account =&gt; !!1,
&nbsp;&nbsp;change =&gt; 1,
&nbsp;&nbsp;index =&gt; 0,
)-&gt;get_basic_key;

# get basic keys for all the kids!
my @kids_keys = map {
&nbsp;&nbsp;$account_key-&gt;derive_key_bip44(
&nbsp;&nbsp;&nbsp;&nbsp;get_from_account =&gt; !!1,
&nbsp;&nbsp;&nbsp;&nbsp;index =&gt; $_,
&nbsp;&nbsp;)-&gt;get_basic_key
} 0 .. $number_of_kids - 1;

McJingles now had all the essential parts needed to create the transaction. He asked the Santa how juicy the presents should be, but all he heard in return was some mumbling about the economy being tough and the need to cut the expenses. He figured 100,000 satoshi (the smallest units) for each kid should do. Adding these outputs turned out to be much simpler than he had anticipated:

use Bitcoin::Crypto qw(btc_transaction);

# create the transaction object
my $tx = btc_transaction-&gt;new;

# add the input from the UTXO
$tx-&gt;add_input(
&nbsp;&nbsp;utxo =&gt; [[hex =&gt; 'a4e407ba6b54106e4bd209704666a2b541b9b03d04ef8cb779aafe18238744e1'], 0],
);

# add all the gift outputs
foreach my $key (@kids_keys) {
&nbsp;&nbsp;$tx-&gt;add_output(
&nbsp;&nbsp;&nbsp;&nbsp;locking_script =&gt; [address =&gt; $key-&gt;get_public_key-&gt;get_address],
&nbsp;&nbsp;&nbsp;&nbsp;value =&gt; 100_000,
&nbsp;&nbsp;);
}

The last thing to do was to add the output for unused funds and adjust the fee. The difference between input and output values is what the miner gets paid to include the transaction in a block. Without adding the change output, the fee paid would be 49.654 BTC! The higher it is the faster the transaction will be mined, but paying over $1.5 million for a transfer was simply too much. The fee must be proportional to the size of a transaction, so McJingles assumed 100 satoshi per output should be enough. He also set his transaction up for RBF (replace-by-fee), so that he could always bump it later if the blockchain got clogged:

# calculate the value of the change output
my $currently_unspent = $tx-&gt;fee;
my $wanted_fee = 100 * @kids_keys;
my $change_value = $currently_unspent - $wanted_fee;

# add the change output as the last output of the transaction
$tx-&gt;add_output(
&nbsp;&nbsp;locking_script =&gt; [address =&gt; $change_key-&gt;get_public_key-&gt;get_address],
&nbsp;&nbsp;value =&gt; $change_value,
);

# set replace-by-fee
$tx-&gt;set_rbf;

The transaction object was complete! Now all he had to do was to sign it and print it to the console. The transaction was not yet sent, but the serialized hex string can be broadcast to the Bitcoin network at any time, since the validity of the transaction won't ever expire!

use Bitcoin::Crypto::Util qw(to_format);

# sign the only input
$priv-&gt;sign_transaction($tx, signing_index =&gt; 0);

# just to make sure everything is okay - try to verify
$tx-&gt;verify;

say $tx-&gt;dump;
say to_format [hex =&gt; $tx-&gt;to_serialized];

When run, the program printed the mnemonic phrase to backup, a user-friendly summary of the transaction and the hex representation of the transaction. But something was missing... Of course, the outputs were supposed to be presents! The list of private keys was left behind in a variable, and without it there was no way to give the outputs to the children.

        Your mnemonic is &lt;brown bulk hire culture capital hill trim turkey gossip artefact door media argue basic execute slam minute try number daughter music gauge vocal wink&gt;
        and your password is &lt;Christmas&gt;
        Back them up!
        Transaction eed9ce72f2ee78c1f2a675172f7694f400e36ead0591b28b662a5e40fb4b20e1
        version: 1
        size: 10883vB, 43532WU
        fee: 34600 sat (~3.17 sat/vB)
        replace-by-fee: yes
        locktime: 0

        1 inputs:
        P2PK Input
        spending output #0 from a4e407ba6b54106e4bd209704666a2b541b9b03d04ef8cb779aafe18238744e1
        value: 5000000000
        sequence: 0xFFFFFFFD
        locking script: 410452b58be18046f78a0045fe49df56387a03f994ba2ac7a26e17f7d01dc6d346f1bed3979ad35d32a75bb625f6e521f75a1c5983d303ea04bfb43c8b72203a68eeac
        signature script: 483045022100b145a5f46f1fb69a3c7b4d55e1fdc5c2a4556129c2517816f4d8b5cc691414c20220055e5a4649021d26974c1b3b981bfecce9ba05cfae0be10ac136ff02e3e9319601

        347 outputs:
        P2WPKH Output to bc1qum6sd22rmsewwd75lzlynuve8wz0ah2uw2gltu
        value: 100000
        locking script: 0014e6f506a943dc32e737d4f8be49f1993b84fedd5c

        (...)

        P2WPKH Output to bc1qyx43gm2rpdrgk0r70xhpt6ru5sk2xg7xs7lvga
        value: 4965365400
        locking script: 001421ab146d430b468b3c7e79ae15e87ca42ca323c6

        0100000001e144872318feaa79b78cef043db0b941b5a266467009d24b6e10546bba07e4a400(...)

McJingles had already safely backed up the mnemonic on a piece of paper, so he decided to write another script to print all the private keys generated. Running the same script again would produce a new mnemonic phrase for him. He couldn't do it as there was always a paper shortage in the toys factory. It should not come as a surprise since all the presents must be wrapped thoroughly, company policy.

It was getting late and he felt exhausted from deciphering all this output. It would be silly to work with Bitcoin being this tired! Any error you make may cause the coins to be lost forever! Well, with great power... yeah yeah, it was best if he just went to bed and left the rest for another day. Still plenty of time before Christmas!

... or is there?

Ornamenting Jingle Bells

2023-12-01T00:00:00Z

SITUATION

Santa was growing tired of the music piped into his workshop.

For example, Jingle Bells was just too ordinary sounding to his ears. It needed a bit of Christmas cheer to pep up the Elves!

And here is a bit of that tune, that plays at the workshop:

Ordinary to say the least!

ASSESSMENT

Santa asked a couple of his more creative elves to come up with a way to brighten things up musically. And they tinkered, the way elves do.

The cowbell was proposed, but that got shot down quick. Eventually, the most musically experienced elf suggested adding "ornamentation" to certain notes. This she said, included commonly heard things like "trills." (And it is said that she toured as a roadie, in the 60s with Hendrix, CSN, and others.)

After some thinking about exactly how to add ornaments to Christmas tunes, a young guitarist elf pointed to CPAN and the Music::MelodicDevice::Ornamentation module, that seemed to fit the bill perfectly.

Then after reading the examples, the team modified the source and gave it a try... They listened to each of the ornaments and decided to trigger them from a dispatch table, based for the moment, on a loop counter. More sophisticated triggers based on advanced music theory concepts were considered, but Christmas was fast approaching!

PROTOTYPE

Here is the prototype code they came up with for Santa. (And it has too much ornamentation for just 16 bars, on purpose for illustration purposes.)

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

use MIDI::Util qw(setup_score midi_format);
use Music::MelodicDevice::Ornamentation ();

# The number of notes before resetting the note counter
use constant MAX =&gt; 16;

# Sixteen measure fragment of &quot;duration.pitch&quot; notes
my @notes = qw(
&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.E4 hn.E4
&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.E4 hn.E4
&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.G4 qn.C4 qn.D4
&nbsp;&nbsp;&nbsp;&nbsp;wn.E4

&nbsp;&nbsp;&nbsp;&nbsp;qn.F4 qn.F4 qn.F4 qn.F4
&nbsp;&nbsp;&nbsp;&nbsp;qn.F4 qn.E4 qn.E4 qn.E4
&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.D4 qn.D4 qn.E4
&nbsp;&nbsp;&nbsp;&nbsp;hn.D4       hn.G4

&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.E4 hn.E4
&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.E4 hn.E4
&nbsp;&nbsp;&nbsp;&nbsp;qn.E4 qn.G4 qn.C4 qn.D4
&nbsp;&nbsp;&nbsp;&nbsp;wn.E4

&nbsp;&nbsp;&nbsp;&nbsp;qn.F4 qn.F4 qn.F4 qn.F4
&nbsp;&nbsp;&nbsp;&nbsp;qn.F4 qn.E4 qn.E4 qn.E4
&nbsp;&nbsp;&nbsp;&nbsp;qn.G4 qn.G4 qn.F4 qn.D4
&nbsp;&nbsp;&nbsp;&nbsp;wn.C4
);

# Setup a new MIDI score
my $melody = setup_score(bpm =&gt; 140);

# Setup a new musical ornament maker
my $ornament = Music::MelodicDevice::Ornamentation-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;scale_note =&gt; 'C',
&nbsp;&nbsp;&nbsp;&nbsp;scale_name =&gt; 'major',
);

# Dazzle with musical ornamentation (based on beat position for now)
my %dazzle = (
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;2 =&gt; sub { $ornament-&gt;mordent(@_, 1) },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;7 =&gt; sub { $ornament-&gt;trill(@_, 2, 1) },
&nbsp;&nbsp;&nbsp;&nbsp;10 =&gt; sub { $ornament-&gt;turn(@_, 1) },
&nbsp;&nbsp;&nbsp;&nbsp;13 =&gt; sub { $ornament-&gt;grace_note(@_, -1) },
);

# For each duration.note pair...
my $counter = 0;
for my $note (@notes) {
&nbsp;&nbsp;&nbsp;&nbsp;my @note = split /\./, $note;

    # Add either an ornamented or a &quot;plain&quot; note to the score
    if (exists $dazzle{$counter}) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $fancy = $dazzle{$counter}-&gt;(@note);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my @fancy = map { [ midi_format(@$_) ] } @$fancy; # turn '#' into 's' and 'b' into 'f'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$melody-&gt;n(@$_) for @fancy;
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;else {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$melody-&gt;n(midi_format(@note));
&nbsp;&nbsp;&nbsp;&nbsp;}

    # Increment the counter, or start over if we've reached the max
    $counter = $counter == MAX ? 0 : $counter + 1;
}

# Write out the fancy score as a MIDI file
$melody-&gt;write_score(&quot;$0-fancy.mid&quot;);

RESULT

And here is the result:

Santa approved the MIDI and the code review, and the team of intrepid elves went to work tastefully implementing ornamentation into the rest of the music system - all driven by Perl, of course!

SYNOPSIS

      $ perl jingle-bells.pl
      $ timidity jingle-bells.pl-fancy.mid  # for unix-like systems

PLAYBACK

On Windows

On Microsoft Windows, use the Legacy Media Player. This app just works. MIDI support was removed from the current Microsoft Media Player app.

On unix-like systems

TiMidity++ is a brilliant software synthesizer that can play MIDI files without a hardware synthesizer. It was written in 1995 by elf, Tuukka Toivonen. A file called a SoundFont tells TiMidity what sounds to play for each MIDI note.

The excellent player, VLC can be used to render MIDI files, too.

Either should be available from your system package manager (apt, homebrew, etc.).

Perl Advent Calendar 2023

24 Years of the Perl Advent Calendar

The Journey

The Stats

The Evolution

Where are we Now?

A Big Thank You

A Big Anniversary

Santa Kotlin is coming to Perl

Stay awhile and listen

Am I still reading the Perl advent calendar?

Perl&#39;s PlayStation

Any chance of having actual code in this post?

Binding to Kotlin from Perl

Elves Versus Unused Imports

Installation

Getting Started

A Configuration File

Integrations

The Power of precious

The State of the Workshop

St. Nick&#39;s Reindeers Need More H2O!

Santa&#39;s Got Options... for Options

Ye Old Configuration Files

Config::Tiny

YAML Files

There is Still More!

Conclusion

Links

Elves Versus Typos

The Tool

Getting Set Up

More Than Just Documentation

Now The Elves Look Smart(er)

A Dotenv Carol

Perl - The Humane Programming Language

Perl - The Humane Programming Language

Get the job done

Do What I Mean

Trust Me

Lessons Learned

Wrapping Up

Trimming audio files with Audio::Nama

Our task

Our tools

Create a new project, add a track and import an audio file

Define our clips

The final gathering

How the sausage is made

Chain setup graph

Basic mixer configuration

Debug output

Assembling our audio clips

Thanks for reading!

Showcase

Notable dependencies

Sequentially Consistent Santa

Santa&rsquo;s Workshop Secrets: The Magical Test2 Suite (Part 2)

Easily mocking objects and classes

Mocking the Christmas Wishlist Database

Santa&rsquo;s Workshop Secrets: The Magical Test2 Suite (Part 1)

The all-powerful &quot;is&quot; and &quot;like&quot;

Test if loading a module imports (or doesn&rsquo;t import) a function or a variable:

Test if something warns or dies / raises an exception

Stop and bail out of testing whenever a single test fails:

Skip tests unless we have a specific perl or module version available:

Introduction to class feature

Background

Singleton using Moo

Implementation of Singleton using new class feature

How about some more?

Santa&#39;s New Dispatcher

My Top 7 Perl New Features

0. Subroutine signatures

1. Substitution returns a copy.

2. Postfix dereference

3. The infix isa

4. Key-value slices

5. Initialize hashes and arrays with state

6. Indented here docs

Perl's PlayStation

St. Nick's Reindeers Need More H2O!

Santa's Got Options... for Options

`Config::Tiny`

`YAML` Files

Santa’s Workshop Secrets: The Magical Test2 Suite (Part 2)

Santa’s Workshop Secrets: The Magical Test2 Suite (Part 1)

The all-powerful "is" and "like"

Test if loading a module imports (or doesn’t import) a function or a variable:

Santa's New Dispatcher

Santa's Helpers' Helpers

Who's That Clicking At The Window?

Santa's Christmas Dancer2 Web App - Naughty & Nice List Manager