Perl Advent Calendar 2022

Fractal Christmas Tree

2022-12-27T00:00:00Z

Merry Christmas and Happy New Year! :-)

Our holiday-themed programming goal is to implement a fun little Perl application, which will display a Christmas tree using the Sierpinski fractal algorithm.

Let's begin by reviewing the code for generating Sierpinski Triangle fractals, stored in a file named Sierpinski.pm.

If you are an experienced Perl programmer, you will immediately notice the definition and utilization of data types such as integer and number, as well as data structures such as integer::arrayref and integer::arrayref::arrayref etc. Data types and data structures, along with other Perl programming strategies such as CRITICS as well as subroutine $RETURN_TYPE and @ARG named input arguments, are included for best practices and compatibility with the Perl compiler.

# [[[ PREPROCESSOR ]]]
# declare Perl-compatible data types &amp; data structures 
package void; 1;
package integer; 1;
package integer::arrayref; 1;
package integer::arrayref::arrayref; 1;
package number::arrayref; 1;
package number::arrayref::arrayref; 1;
package number::arrayref::arrayref::arrayref; 1;
package number::arrayref::arrayref::arrayref::arrayref; 1;

# [[[ HEADER ]]]
#use RPerl;  # replaced by PREPROCESSOR for simplicity
package MathPerl::Fractal::Sierpinski;
use strict;
use warnings;
use v5.14;  # required for /r return AKA non-destructive regex flag
our $VERSION = 0.008_000;

# [[[ CRITICS ]]]
# USER DEFAULT 1: allow numeric values &amp; print operator
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls)
## no critic qw(RequireInterpolationOfMetachars)  # USER DEFAULT 2: allow single-quoted control characters &amp; sigils
## no critic qw(ProhibitConstantPragma ProhibitMagicNumbers)  # USER DEFAULT 3: allow constants

# [[[ OO INHERITANCE ]]]
#use parent qw(MathPerl::Fractal);  # disable unnecessary inheritance for simplicity
#use MathPerl::Fractal;

# [[[ INCLUDES ]]]
use English;
use Data::Dumper;
$Data::Dumper::Deepcopy = 1;  # display human-readable numeric data, not $VAR1-&gt;[0] references

# [[[ SUBROUTINES ]]]

# recursively generate triangles, grouped by recursion level
sub sierpinski {
&nbsp;&nbsp;&nbsp;&nbsp;{ my void $RETURN_TYPE };
&nbsp;&nbsp;&nbsp;&nbsp;(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $triangle,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my integer $recursions_remaining,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref::arrayref::arrayref $triangle_groups
&nbsp;&nbsp;&nbsp;&nbsp;) = @ARG;

&nbsp;&nbsp;&nbsp;&nbsp;print 'in sierpinski(), received $recursions_remaining = ', $recursions_remaining, &quot;\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;print 'in sierpinski(), received $triangle = ', (Dumper($triangle) =~ s/'//gr), &quot;\n&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;if ($recursions_remaining &gt; 0) {
        # shortcut variables, easier to read in midpoint calculations below
        my number::arrayref $point_a = $triangle-&gt;[0];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_b = $triangle-&gt;[1];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_c = $triangle-&gt;[2];

        # calculate midpoints between two coordinates [x1, y1] and [x2, y2] is [(x1+x2)/2, (y1+y2)/2]
        my number::arrayref $point_a_b =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[(($point_a-&gt;[0] + $point_b-&gt;[0]) / 2),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(($point_a-&gt;[1] + $point_b-&gt;[1]) / 2)];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_a_c =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[(($point_a-&gt;[0] + $point_c-&gt;[0]) / 2),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(($point_a-&gt;[1] + $point_c-&gt;[1]) / 2)];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_b_c =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[(($point_b-&gt;[0] + $point_c-&gt;[0]) / 2),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(($point_b-&gt;[1] + $point_c-&gt;[1]) / 2)];

        # construct 3 sub-triangles from orinal points and newly-calculated midpoints
        my number::arrayref::arrayref $subtriangle_a = [ $point_a,   $point_a_b, $point_a_c ];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $subtriangle_b = [ $point_a_b, $point_b,   $point_b_c ];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $subtriangle_c = [ $point_a_c, $point_b_c, $point_c   ];

        # $triangle_groups is zero-indexed like all other Perl arrays,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# so we need to subtract one from $recursions_remaining before using as an index,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# in order to avoid an undefined element at element 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# also, we need to decrement $recursions_remaining before making recursive calls;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# for both of these reasons, we can decrement now
        $recursions_remaining--;

        # store all triangles grouped by recursion level
        push @{$triangle_groups-&gt;[$recursions_remaining]}, $subtriangle_a;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @{$triangle_groups-&gt;[$recursions_remaining]}, $subtriangle_b;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @{$triangle_groups-&gt;[$recursions_remaining]}, $subtriangle_c;

        # recurse once for each sub-triangle
        sierpinski( $subtriangle_a, $recursions_remaining, $triangle_groups);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sierpinski( $subtriangle_b, $recursions_remaining, $triangle_groups);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sierpinski( $subtriangle_c, $recursions_remaining, $triangle_groups);
&nbsp;&nbsp;&nbsp;&nbsp;}

    # return after maximum recursion level is reached (conditional block above not entered),
&nbsp;&nbsp;&nbsp;&nbsp;# or all recursion calls have returned (conditional block above entered);
&nbsp;&nbsp;&nbsp;&nbsp;# no return value, all generated data is stored directly in $triangle_groups
    return;
}

1;  # end of class

Let's see what happens when we call the sierpinski() subroutine, passing in only 1 level of recursion for simplicity...

The recursion directly populates $retval in reverse order, from highest index to lowest index, eventually ending at index 0 with no further recursion to be done, and all the values are returned back to the original subroutine call. Because of this reverse-index population, the hard-coded initial triangle is stored at the highest (not the lowest) index in $retval, as you can see in the Perl one-liner (two-liner?) below. The initial triangle's hard-coded definition is done during declaration for brevity, and the to-be-populated element is left as undef.

$ perl -e &#39;use MathPerl::Fractal::Sierpinski; my $retval = [undef, [[512, 100], [212, 600], [812, 600]]];
&nbsp;&nbsp;&nbsp;&nbsp;MathPerl::Fractal::Sierpinski::sierpinski($retval-&gt;[1], 1, $retval);&#39;

First, sierpinski() will display the 3 [ x, y ] cartesian coordinates representing the 3 corners of our initial input triangle, received in the my number::arrayref::arrayref $triangle argument:

in sierpinski(), received $recursions_remaining = 1
in sierpinski(), received $triangle = $VAR1 = [ [ 512, 100 ], [ 212, 600 ], [ 812, 600 ] ];

Then the Sierpinski algorithm creates 3 sub-triangles and makes a recursive call to sierpinski() for each sub-triangle:

in sierpinski(), received $recursions_remaining = 0
in sierpinski(), received $triangle = $VAR1 = [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;100
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;362,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;662,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;];

in sierpinski(), received $recursions_remaining = 0
in sierpinski(), received $triangle = $VAR1 = [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;362,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;212,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;];

in sierpinski(), received $recursions_remaining = 0
in sierpinski(), received $triangle = $VAR1 = [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;662,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;812,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;];

If we were to render these 3 sub-triangles in white, it would look like a monochrome triforce:

After all recursion has completed, we are left with our final number::arrayref::arrayref::arrayref::arrayref data structure, which contains all generated triangles grouped by recursion level:

have $my_triangle_groups = 
$VAR1 = [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;100
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;362,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;662,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;362,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;212,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;662,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;350
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;812,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;512,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;100
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;212,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;812,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;600
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;];

Ultimately, it is the $my_triangle_groups data which will be rendered to comprise the main triangular body of the Christmas tree.

Next let's review the Perl code for generating the Christmas Tree data and rendering the Simple DirectMedia Layer (SDL) graphics, stored in a file named ChristmasTree.pm:

# [[[ HEADER ]]]
#use RPerl;  # disabled for simplicity; data types declared in Sierpinski.pm &amp; inherited below
package MathPerl::Fractal::ChristmasTree;
use strict;
use warnings;
use v5.14;  # required for /r return AKA non-destructive regex flag
our $VERSION = 0.008_000;

# [[[ CRITICS ]]]
# USER DEFAULT 1: allow numeric values &amp; print operator
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls)
## no critic qw(RequireInterpolationOfMetachars)  # USER DEFAULT 2: allow single-quoted control characters &amp; sigils
## no critic qw(ProhibitConstantPragma ProhibitMagicNumbers)  # USER DEFAULT 3: allow constants

# [[[ OO INHERITANCE ]]]
use parent qw(MathPerl::Fractal::Sierpinski);
use MathPerl::Fractal::Sierpinski;

# [[[ INCLUDES ]]]
use English;
use Data::Dumper;
$Data::Dumper::Deepcopy = 1;  # display human-readable numeric data, not $VAR1-&gt;[0] references

# https://metacpan.org/dist/SDL/view/lib/pods/SDL/Event.pod
use SDL;
use SDLx::App;   # used for window creation &amp; control
use SDL::Event;  # used for creating Event object
use SDL::Events; # used for Event queue handling functions
use Time::HiRes qw( gettimeofday usleep );  # used for time-based animation control

# [[[ SUBROUTINES ]]]

# display an animated Christmas tree!
# define hard-coded constant data; call sierpinski() to recursively generate fractal triangles;
# initialize SDL graphics; render static graphics; render dynamic graphics (animation)
sub generate_fractal__render_animation {
&nbsp;&nbsp;&nbsp;&nbsp;{ my void $RETURN_TYPE };

    # [ DATA FOR SIZES &amp; SHAPES &amp; COLORS;
&nbsp;&nbsp;&nbsp;&nbsp;#   HARD-CODED 1024x768 RESOLUTION &amp; 32-BIT COLOR DEPTH ]

    # initial triangle's 3 corners as [x, y] Euclidean coordinates
    my number::arrayref::arrayref $my_triangle_initial =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[[ 512, 100],  # top point
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 212, 600],  # bottom left
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 812, 600]]; # bottom right

&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_red     = [255, 000, 000, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_pink    = [255, 105, 220, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_orange  = [255, 150, 000, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_yellow  = [255, 255, 000, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_green   = [000, 220, 000, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_blue    = [000, 000, 255, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_purple  = [175, 000, 255, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_white   = [255, 255, 255, 255];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color_brown   = [140, 100, 000, 255];

    # colors as [r, g, b] triplets; number of colors is number of recursions
    my integer::arrayref::arrayref $my_triangle_colors =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ $my_color_green,  # green needs to be the color of the smallest, and thus most numerous, triangles
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_pink,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_blue,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_red,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_white ];
&nbsp;&nbsp;&nbsp;&nbsp;my integer $my_recursions_remaining = scalar(@{$my_triangle_colors});

    # rectangle in format [ x, y, width, height ]
    my number::arrayref::arrayref $my_rectangle_trunk =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[462, 601, 100, 100];

&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle_star_up =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[[ 512, 050],  # top point
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 462, 130],  # bottom left
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 562, 130]]; # bottom right
&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle_star_down =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[[ 512, 155],  # bottom point
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 462,  70],  # top left
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 562,  70]]; # top right

    # colors for animated Christmas tree lights
    my integer::arrayref::arrayref $my_lights_colors = [$my_color_pink, $my_color_purple, $my_color_orange];

    # [ PREPARE &amp; MAKE INITIAL RECURSIVE CALL ]

    # declare &amp; initialize final array outside of the recursive subroutine for easy direct access by all recursive calls
    my number::arrayref::arrayref::arrayref::arrayref $my_triangle_groups = [];

    # initial triangle is in a triangle group by itself
    $my_triangle_groups-&gt;[$my_recursions_remaining] = [$my_triangle_initial];

    # initial call to recursive subroutine
    MathPerl::Fractal::Sierpinski::sierpinski($my_triangle_initial, $my_recursions_remaining, $my_triangle_groups);

    # regex to (g)lobally (s)earch for numbers incorrectly wrapped in 'single-quotes' by Dumper,
&nbsp;&nbsp;&nbsp;&nbsp;# replace by // empty string, no lvalue $variable so directly (r)eturn modified string;
&nbsp;&nbsp;&nbsp;&nbsp;# https://perldoc.perl.org/perlop#s%2FPATTERN%2FREPLACEMENT%2Fmsixpodualngcer
    print 'have $my_triangle_groups = ', &quot;\n&quot;, (Dumper($my_triangle_groups) =~ s/'//gr);

    # [ INITIALIZE GRAPHICS ]

    # https://metacpan.org/dist/SDL/view/lib/pods/SDL/Events.pod
    my @SDL_EVENTS = qw(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;no_such_event
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_ACTIVEEVENT
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_KEYDOWN SDL_KEYUP
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_MOUSEMOTION SDL_MOUSEBUTTONDOWN SDL_MOUSEBUTTONUP
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_JOYAXISMOTION SDL_JOYBALLMOTION SDL_JOYHATMOTION SDL_JOYBUTTONDOWN SDL_JOYBUTTONUP
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_QUIT
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_SYSWMEVENT
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_VIDEORESIZE SDL_VIDEOEXPOSE
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_USEREVENT
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SDL_NUMEVENTS
&nbsp;&nbsp;&nbsp;&nbsp;);  # constant data

    # SDL includes moved into [[[ INCLUDES ]]] section above

    # initialize SDL video &amp; application &amp; event;
&nbsp;&nbsp;&nbsp;&nbsp;# we do not call $my_SDL_app-&gt;run() anywhere in this program, instead we use the while() run loop below
    SDL::init(SDL_INIT_VIDEO);
&nbsp;&nbsp;&nbsp;&nbsp;my SDLx::App $my_SDL_app = SDLx::App-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;title  =&gt; 'Merry Christmas!!  Perl Advent 2022!!!',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;width  =&gt; 1024,                     # hard-coded 1024x768 resolution
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;height =&gt; 768,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;depth  =&gt; 32,                       # hard-coded 32-bit color
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;resizeable =&gt; 1                     # allow window resize; does not scale window contents
&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;my $my_SDL_event = SDL::Event-&gt;new;

    # [ RENDER STATIC GRAPHICS ]

    # draw Christmas tree branches &amp; snow tinsel &amp; ornaments &amp; lights;
&nbsp;&nbsp;&nbsp;&nbsp;# iterate through triangle groups in reverse order, due to reverse population during recursion
    for (my $i = ((scalar @{$my_triangle_groups}) - 1); $i &gt;= 0; $i--) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref::arrayref $my_triangle_group = $my_triangle_groups-&gt;[$i];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color = $my_triangle_colors-&gt;[$i];

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for (my $j = 0; $j &lt; (scalar @{$my_triangle_group}); $j++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle = $my_triangle_group-&gt;[$j];

            # https://metacpan.org/dist/SDL/view/lib/pods/SDLx/Surface.pod
            $my_SDL_app-&gt;draw_trigon_filled( $my_triangle, $my_color );

            # refresh window on every triangle for fun cascade drawing effect
            $my_SDL_app-&gt;update();
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}

    # draw Christmas tree trunk &amp; Star of Bethlehem
    $my_SDL_app-&gt;draw_rect( $my_rectangle_trunk, $my_color_brown );
&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_up, $my_color_yellow );
&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_down, $my_color_yellow );
&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;update();  # refresh window

    # [ RENDER DYNAMIC (ANIMATED) GRAPHICS ]

    # set initial index for accessing Christmas tree lights colors
    my integer $my_lights_colors_index = 0;

    # set initial time for changing Christmas tree lights colors
    (my integer $seconds_start) = gettimeofday();
    #print 'have $seconds_start = ', $seconds_start, &quot;\n&quot;;

    # the main run loop, used instead of calling $my_SDL_app-&gt;run();
&nbsp;&nbsp;&nbsp;&nbsp;# animate forever, until SDL_QUIT event is received in GUI window via &lt;Alt-F4&gt; keypress or window close mouse click,
&nbsp;&nbsp;&nbsp;&nbsp;# or in CLI window via &lt;Ctrl-C&gt; keypress
    while(1)
&nbsp;&nbsp;&nbsp;&nbsp;{
        # pump the event loop, gathering events from input devices
        SDL::Events::pump_events();

        # poll for currently pending events
        if(SDL::Events::poll_event($my_SDL_event))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print 'have @SDL_EVENTS[', $my_SDL_event-&gt;type(), '] = ', @SDL_EVENTS[$my_SDL_event-&gt;type()], &quot;\n&quot;;

            # we only care about the SDL_QUIT event telling us to exit
            if ($my_SDL_event-&gt;type == SDL_QUIT) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print 'SDL_QUIT event received, exiting', &quot;\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;exit;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;
        # get current time, for comparison with start time of current Christmas tree lights color
        (my integer $seconds_current) = gettimeofday();
    #    print 'have $seconds_current = ', $seconds_current, &quot;\n&quot;;

        # twinkle Christmas tree lights every 1 second
        if (($seconds_current - $seconds_start) &gt;= 1) {
            # reset start time to current time, for time cycle of next animation frame
            $seconds_start = $seconds_current;

            # iterate through lights colors
            my integer::arrayref $my_color = $my_lights_colors-&gt;[$my_lights_colors_index];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print 'have $my_color = $my_lights_colors-&gt;[', $my_lights_colors_index, '] = ', Dumper($my_color);

            # wrap back to beginning of lights colors when end is reached
            $my_lights_colors_index++;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if ($my_lights_colors_index &gt; ((scalar @{$my_lights_colors}) - 1)) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_lights_colors_index = 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

            # only update second-smallest triangles, not the green of the Christmas tree itself
            my number::arrayref::arrayref::arrayref $my_triangle_group = $my_triangle_groups-&gt;[1];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for (my $j = 0; $j &lt; (scalar @{$my_triangle_group}); $j++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle = $my_triangle_group-&gt;[$j];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle, $my_color );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

            # redraw green of Christmas tree
            $my_triangle_group = $my_triangle_groups-&gt;[0];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for (my $j = 0; $j &lt; (scalar @{$my_triangle_group}); $j++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle = $my_triangle_group-&gt;[$j];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle, $my_triangle_colors-&gt;[0] );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

            # redraw Star of Bethlehem
            $my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_up, $my_color_yellow );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_down, $my_color_yellow );

            # refresh window once for every Christmas tree lights color change, for synchronized lights
            $my_SDL_app-&gt;update();
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

        # briefly pause between each while() loop iteration, to avoid overloading CPU;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# ( 1_000_000 microseconds per second ) / ( 10_000 microseconds per iteration) = 100 iterations per second;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# need at least 100 while loop iterations per second, in order to process all of the otherwise-ignored
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# SDL_MOUSEMOTION events which are caused by simply moving the mouse over top of the window
        usleep(10_000);
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;return;
}  # end of generate_fractal__render_animation()

1;  # end of class

The above Christmas tree code is pretty much the simplest 2-D graphics rendering system I could write using SDL, with the ability to be exited gracefully instead of having to type Ctrl-Z and then $ killall -KILL perl.

Last, we only need a few lines of driver code to run it all:

sierpinski_triangles_christmas.pl

#!/usr/bin/env perl

# Fractal Christmas Tree
# Sierpinski triangles animated using SDL graphics

# [[[ HEADER ]]]
use strict;
use warnings;
our $VERSION = 0.008_000;

# [[[ INCLUDES ]]]
use MathPerl::Fractal::ChristmasTree;

# [[[ OPERATIONS ]]]
MathPerl::Fractal::ChristmasTree::generate_fractal__render_animation();

If you were to run the above program, which includes 5 colors for 5 levels of recursion, then you would see a rendered series of images similar to the following:

$ ./sierpinski_triangles_christmas.pl

However, before you can run this program you will need to install the SDL dependencies:

$ cpanm -v SDL SDLx::App SDL::Event SDL::Events

Also, the easiest way to run this Fractal Christmas Tree program is to copy or download the monolithic code below (instead of all 3 files above), and then paste it into a single executable Perl file:

sierpinski_triangles_christmas_monolith.pl

#!/usr/bin/env perl

# Fractal Christmas Tree, Monolithic Single File
# Sierpinski triangles animated using SDL graphics

# [[[ PREPROCESSOR ]]]
# declare Perl-compatible data types &amp; data structures 
package void; 1;
package integer; 1;
package integer::arrayref; 1;
package integer::arrayref::arrayref; 1;
package number::arrayref; 1;
package number::arrayref::arrayref; 1;
package number::arrayref::arrayref::arrayref; 1;
package number::arrayref::arrayref::arrayref::arrayref; 1;

# [[[ HEADER ]]]
package main;
use strict;
use warnings;
use v5.14;  # required for /r return AKA non-destructive regex flag
our $VERSION = 0.008_000;

# [[[ CRITICS ]]]
# USER DEFAULT 1: allow numeric values &amp; print operator
## no critic qw(ProhibitUselessNoCritic ProhibitMagicNumbers RequireCheckedSyscalls)
## no critic qw(RequireInterpolationOfMetachars)  # USER DEFAULT 2: allow single-quoted control characters &amp; sigils
## no critic qw(ProhibitConstantPragma ProhibitMagicNumbers)  # USER DEFAULT 3: allow constants

# [[[ INCLUDES ]]]
use English;
use Data::Dumper;
$Data::Dumper::Deepcopy = 1;  # display human-readable numeric data, not $VAR1-&gt;[0] references

# https://metacpan.org/dist/SDL/view/lib/pods/SDL/Event.pod
use SDL;
use SDLx::App;   # used for window creation &amp; control
use SDL::Event;  # used for creating Event object
use SDL::Events; # used for Event queue handling functions
use Time::HiRes qw( gettimeofday usleep );  # used for time-based animation control

# [[[ CONSTANTS ]]]

# [ DATA FOR SIZES &amp; SHAPES &amp; COLORS;
#   HARD-CODED 1024x768 RESOLUTION &amp; 32-BIT COLOR DEPTH ]

# initial triangle's 3 corners as [x, y] Euclidean coordinates
my number::arrayref::arrayref $my_triangle_initial =
&nbsp;&nbsp;&nbsp;&nbsp;[[ 512, 100],  # top point
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 212, 600],  # bottom left
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 812, 600]]; # bottom right

my integer::arrayref $my_color_red     = [255, 000, 000, 255];
my integer::arrayref $my_color_pink    = [255, 105, 220, 255];
my integer::arrayref $my_color_orange  = [255, 150, 000, 255];
my integer::arrayref $my_color_yellow  = [255, 255, 000, 255];
my integer::arrayref $my_color_green   = [000, 220, 000, 255];
my integer::arrayref $my_color_blue    = [000, 000, 255, 255];
my integer::arrayref $my_color_purple  = [175, 000, 255, 255];
my integer::arrayref $my_color_white   = [255, 255, 255, 255];
my integer::arrayref $my_color_brown   = [140, 100, 000, 255];

# colors as [r, g, b] triplets; number of colors is number of recursions
my integer::arrayref::arrayref $my_triangle_colors =
&nbsp;&nbsp;&nbsp;&nbsp;[ $my_color_green,  # green needs to be the color of the smallest, and thus most numerous, triangles
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_pink,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_blue,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_red,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_color_white ];
my integer $my_recursions_remaining = scalar(@{$my_triangle_colors});

# rectangle in format [ x, y, width, height ]
my number::arrayref::arrayref $my_rectangle_trunk =
&nbsp;&nbsp;&nbsp;&nbsp;[462, 601, 100, 100];

my number::arrayref::arrayref $my_triangle_star_up =
&nbsp;&nbsp;&nbsp;&nbsp;[[ 512, 050],  # top point
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 462, 130],  # bottom left
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 562, 130]]; # bottom right
my number::arrayref::arrayref $my_triangle_star_down =
&nbsp;&nbsp;&nbsp;&nbsp;[[ 512, 155],  # bottom point
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 462,  70],  # top left
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[ 562,  70]]; # top right

# colors for animated Christmas tree lights
my integer::arrayref::arrayref $my_lights_colors = [$my_color_pink, $my_color_purple, $my_color_orange];

# https://metacpan.org/dist/SDL/view/lib/pods/SDL/Events.pod
my @SDL_EVENTS = qw(
&nbsp;&nbsp;&nbsp;&nbsp;no_such_event
&nbsp;&nbsp;&nbsp;&nbsp;SDL_ACTIVEEVENT
&nbsp;&nbsp;&nbsp;&nbsp;SDL_KEYDOWN SDL_KEYUP
&nbsp;&nbsp;&nbsp;&nbsp;SDL_MOUSEMOTION SDL_MOUSEBUTTONDOWN SDL_MOUSEBUTTONUP
&nbsp;&nbsp;&nbsp;&nbsp;SDL_JOYAXISMOTION SDL_JOYBALLMOTION SDL_JOYHATMOTION SDL_JOYBUTTONDOWN SDL_JOYBUTTONUP
&nbsp;&nbsp;&nbsp;&nbsp;SDL_QUIT
&nbsp;&nbsp;&nbsp;&nbsp;SDL_SYSWMEVENT
&nbsp;&nbsp;&nbsp;&nbsp;SDL_VIDEORESIZE SDL_VIDEOEXPOSE
&nbsp;&nbsp;&nbsp;&nbsp;SDL_USEREVENT
&nbsp;&nbsp;&nbsp;&nbsp;SDL_NUMEVENTS
);  # constant data

# [[[ OPERATIONS ]]]

# [ PREPARE &amp; MAKE INITIAL RECURSIVE CALL ]

# declare &amp; initialize final array outside of the recursive subroutine for easy direct access by all recursive calls
my number::arrayref::arrayref::arrayref::arrayref $my_triangle_groups = [];

# initial triangle is in a triangle group by itself
$my_triangle_groups-&gt;[$my_recursions_remaining] = [$my_triangle_initial];

# initial call to recursive subroutine
sierpinski($my_triangle_initial, $my_recursions_remaining, $my_triangle_groups);

# regex to (g)lobally (s)earch for numbers incorrectly wrapped in 'single-quotes' by Dumper,
# replace by // empty string, no lvalue $variable so directly (r)eturn modified string;
# https://perldoc.perl.org/perlop#s%2FPATTERN%2FREPLACEMENT%2Fmsixpodualngcer
print 'have $my_triangle_groups = ', &quot;\n&quot;, (Dumper($my_triangle_groups) =~ s/'//gr);

# [ INITIALIZE GRAPHICS ]

# SDL includes moved into [[[ INCLUDES ]]] section above

# initialize SDL video &amp; application &amp; event;
# we do not call $my_SDL_app-&gt;run() anywhere in this program, instead we use the while() run loop below
SDL::init(SDL_INIT_VIDEO);
my SDLx::App $my_SDL_app = SDLx::App-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;title  =&gt; 'Merry Christmas!!  Perl Advent 2022!!!',
&nbsp;&nbsp;&nbsp;&nbsp;width  =&gt; 1024,                     # hard-coded 1024x768 resolution
&nbsp;&nbsp;&nbsp;&nbsp;height =&gt; 768,
&nbsp;&nbsp;&nbsp;&nbsp;depth  =&gt; 32,                       # hard-coded 32-bit color
&nbsp;&nbsp;&nbsp;&nbsp;resizeable =&gt; 1                     # allow window resize; does not scale window contents
);
my $my_SDL_event = SDL::Event-&gt;new;

# [ RENDER STATIC GRAPHICS ]

# draw Christmas tree branches &amp; snow tinsel &amp; ornaments &amp; lights;
# iterate through triangle groups in reverse order, due to reverse population during recursion
for (my $i = ((scalar @{$my_triangle_groups}) - 1); $i &gt;= 0; $i--) {
&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref::arrayref $my_triangle_group = $my_triangle_groups-&gt;[$i];
&nbsp;&nbsp;&nbsp;&nbsp;my integer::arrayref $my_color = $my_triangle_colors-&gt;[$i];

&nbsp;&nbsp;&nbsp;&nbsp;for (my $j = 0; $j &lt; (scalar @{$my_triangle_group}); $j++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle = $my_triangle_group-&gt;[$j];

        # https://metacpan.org/dist/SDL/view/lib/pods/SDLx/Surface.pod
        $my_SDL_app-&gt;draw_trigon_filled( $my_triangle, $my_color );

        # refresh window on every triangle for fun cascade drawing effect
        $my_SDL_app-&gt;update();
&nbsp;&nbsp;&nbsp;&nbsp;}
}

# draw Christmas tree trunk &amp; Star of Bethlehem
$my_SDL_app-&gt;draw_rect( $my_rectangle_trunk, $my_color_brown );
$my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_up, $my_color_yellow );
$my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_down, $my_color_yellow );
$my_SDL_app-&gt;update();  # refresh window

# [ RENDER DYNAMIC (ANIMATED) GRAPHICS ]

# set initial index for accessing Christmas tree lights colors
my integer $my_lights_colors_index = 0;

# set initial time for changing Christmas tree lights colors
(my integer $seconds_start) = gettimeofday();
#print 'have $seconds_start = ', $seconds_start, &quot;\n&quot;;

# the main run loop, used instead of calling $my_SDL_app-&gt;run();
# animate forever, until SDL_QUIT event is received in GUI window via &lt;Alt-F4&gt; keypress or window close mouse click,
# or in CLI window via &lt;Ctrl-C&gt; keypress
while(1)
{
    # pump the event loop, gathering events from input devices
    SDL::Events::pump_events();

    # poll for currently pending events
    if(SDL::Events::poll_event($my_SDL_event))
&nbsp;&nbsp;&nbsp;&nbsp;{
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print 'have @SDL_EVENTS[', $my_SDL_event-&gt;type(), '] = ', @SDL_EVENTS[$my_SDL_event-&gt;type()], &quot;\n&quot;;

        # we only care about the SDL_QUIT event telling us to exit
        if ($my_SDL_event-&gt;type == SDL_QUIT) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print 'SDL_QUIT event received, exiting', &quot;\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;exit;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;&nbsp;&nbsp;&nbsp;}
&nbsp;
    # get current time, for comparison with start time of current Christmas tree lights color
    (my integer $seconds_current) = gettimeofday();
#    print 'have $seconds_current = ', $seconds_current, &quot;\n&quot;;

    # twinkle Christmas tree lights every 1 second
    if (($seconds_current - $seconds_start) &gt;= 1) {
        # reset start time to current time, for time cycle of next animation frame
        $seconds_start = $seconds_current;

        # iterate through lights colors
        my integer::arrayref $my_color = $my_lights_colors-&gt;[$my_lights_colors_index];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print 'have $my_color = $my_lights_colors-&gt;[', $my_lights_colors_index, '] = ', Dumper($my_color);

        # wrap back to beginning of lights colors when end is reached
        $my_lights_colors_index++;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if ($my_lights_colors_index &gt; ((scalar @{$my_lights_colors}) - 1)) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_lights_colors_index = 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

        # only update second-smallest triangles, not the green of the Christmas tree itself
        my number::arrayref::arrayref::arrayref $my_triangle_group = $my_triangle_groups-&gt;[1];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for (my $j = 0; $j &lt; (scalar @{$my_triangle_group}); $j++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle = $my_triangle_group-&gt;[$j];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle, $my_color );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

        # redraw green of Christmas tree
        $my_triangle_group = $my_triangle_groups-&gt;[0];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for (my $j = 0; $j &lt; (scalar @{$my_triangle_group}); $j++) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $my_triangle = $my_triangle_group-&gt;[$j];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle, $my_triangle_colors-&gt;[0] );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}

        # redraw Star of Bethlehem
        $my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_up, $my_color_yellow );
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$my_SDL_app-&gt;draw_trigon_filled( $my_triangle_star_down, $my_color_yellow );

        # refresh window once for every Christmas tree lights color change, for synchronized lights
        $my_SDL_app-&gt;update();
&nbsp;&nbsp;&nbsp;&nbsp;}

    # briefly pause between each while() loop iteration, to avoid overloading CPU;
&nbsp;&nbsp;&nbsp;&nbsp;# ( 1_000_000 microseconds per second ) / ( 10_000 microseconds per iteration) = 100 iterations per second;
&nbsp;&nbsp;&nbsp;&nbsp;# need at least 100 while loop iterations per second, in order to process all of the otherwise-ignored
&nbsp;&nbsp;&nbsp;&nbsp;# SDL_MOUSEMOTION events which are caused by simply moving the mouse over top of the window
    usleep(10_000);
}

# [[[ SUBROUTINES ]]]

# recursively generate triangles, grouped by recursion level
sub sierpinski {
&nbsp;&nbsp;&nbsp;&nbsp;{ my void $RETURN_TYPE };
&nbsp;&nbsp;&nbsp;&nbsp;(
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $triangle,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my integer $recursions_remaining,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref::arrayref::arrayref $triangle_groups
&nbsp;&nbsp;&nbsp;&nbsp;) = @ARG;

&nbsp;&nbsp;&nbsp;&nbsp;print 'in sierpinski(), received $recursions_remaining = ', $recursions_remaining, &quot;\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;print 'in sierpinski(), received $triangle = ', (Dumper($triangle) =~ s/'//gr), &quot;\n&quot;;

&nbsp;&nbsp;&nbsp;&nbsp;if ($recursions_remaining &gt; 0) {
        # shortcut variables, easier to read in midpoint calculations below
        my number::arrayref $point_a = $triangle-&gt;[0];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_b = $triangle-&gt;[1];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_c = $triangle-&gt;[2];

        # calculate midpoints between two coordinates [x1, y1] and [x2, y2] is [(x1+x2)/2, (y1+y2)/2]
        my number::arrayref $point_a_b =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[(($point_a-&gt;[0] + $point_b-&gt;[0]) / 2),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(($point_a-&gt;[1] + $point_b-&gt;[1]) / 2)];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_a_c =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[(($point_a-&gt;[0] + $point_c-&gt;[0]) / 2),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(($point_a-&gt;[1] + $point_c-&gt;[1]) / 2)];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref $point_b_c =
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[(($point_b-&gt;[0] + $point_c-&gt;[0]) / 2),
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(($point_b-&gt;[1] + $point_c-&gt;[1]) / 2)];

        # construct 3 sub-triangles from orinal points and newly-calculated midpoints
        my number::arrayref::arrayref $subtriangle_a = [ $point_a,   $point_a_b, $point_a_c ];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $subtriangle_b = [ $point_a_b, $point_b,   $point_b_c ];
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my number::arrayref::arrayref $subtriangle_c = [ $point_a_c, $point_b_c, $point_c   ];

        # $triangle_groups is zero-indexed like all other Perl arrays,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# so we need to subtract one from $recursions_remaining before using as an index,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# in order to avoid an undefined element at element 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# also, we need to decrement $recursions_remaining before making recursive calls;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;# for both of these reasons, we can decrement now
        $recursions_remaining--;

        # store all triangles grouped by recursion level
        push @{$triangle_groups-&gt;[$recursions_remaining]}, $subtriangle_a;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @{$triangle_groups-&gt;[$recursions_remaining]}, $subtriangle_b;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;push @{$triangle_groups-&gt;[$recursions_remaining]}, $subtriangle_c;

        # recurse once for each sub-triangle
        sierpinski( $subtriangle_a, $recursions_remaining, $triangle_groups);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sierpinski( $subtriangle_b, $recursions_remaining, $triangle_groups);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sierpinski( $subtriangle_c, $recursions_remaining, $triangle_groups);
&nbsp;&nbsp;&nbsp;&nbsp;}

    # return after maximum recursion level is reached (conditional block above not entered),
&nbsp;&nbsp;&nbsp;&nbsp;# or all recursion calls have returned (conditional block above entered);
&nbsp;&nbsp;&nbsp;&nbsp;# no return value, all generated data is stored directly in $triangle_groups
    return;
}

1;  # end of package 'main'

If you review the graphics rendering code above, you will see the while(1) main run loop which twinkles the Christmas tree lights, displaying an animated color change once every second.

Run it yourself and bask in the Perl yuletide glory of your very own Sierpinski triangle fractal Christmas tree!

$ ./sierpinski_triangles_christmas_monolith.pl

Merry Christmas to all, and to all a good night! :-)

Create Your Excel using Perl!

2022-12-26T00:00:00Z

Create Your Excel using Perl!

Intro

A long-long time ago, during the Advent of 2001, there was an article about manipulating Excel spreadsheets using Perl, Spreadsheet::WriteExcel. It's been a while now, so Santa decided to ask the Wise Old Elf to write another article about creating Excel files using Perl.

There were only 3 days until Advent, with lots of articles missing, so the Wise Old Elf immediately delegated this task to Wunorse Openslae, and he chose wisely - as always. Wunorse was a master of managing Excel files and started to work on that article immediately.

Preface

Some historical background: The older module Spreadsheet::WriteExcel is for creating Excel files compatible with Excel 97, 2000, 2002, 2003 and 2007, mainly with .xls extension. It is mostly compatible with Excel::Writer::XLSX, so migrating to the newer version should be as easy as Christmas pie. However such a migration is more like a heavy Christmas pudding loaded with goodness and lots of issues might arise during the process.

You can use Spreadsheet::ParseExcel for reading the older Excel files having .xls extension, on the other hand you should use Spreadsheet::ParseXLSX or Spreadsheet::XLSX to open and manipulate existing Excel files having the .xlsx extension. This article deals with creating Excel files in .xlsx format.

Basics

First things first: import the module, initialize an .xlsx file, add some worksheets, input some data on them and finally close the file, as you would do with a usual filehandle. This looks a bit different, though:

use Excel::Writer::XLSX;

#Create excel file               
my $merry = Excel::Writer::XLSX-&gt;new( &#39;xmas.xlsx&#39; );
#create the workbooks
my $xmas = $merry-&gt;add_worksheet(&#39;Merry&#39;);
my $baking_sheet = $merry-&gt;add_worksheet(&#39;Xmas&#39;);
my $stats = $merry-&gt;add_worksheet(&#39;Everybody!&#39;);
$xmas-&gt;write( &#39;A1&#39;, &#39;Merry Christmas!&#39; );
$merry-&gt;close();

I skipped to display the usual stuff from the beginning of the script, everyone should know by heart: use strict; use warnings;, etc. This will be the skeleton or the Christmas themed frame of our script. You can put everything else in between, depending on Santa's needs, a list of Christmas cookies from around Europe in hash format is a good example, including some stats.

Formatting

To add some format to your cells, use the add_format() method. You can either just call it on your $workbook without parameters or pass a hash of formatting properties to it. The rest depends on your choice from the two options. It is more convenient - in my opinion - to create a format object with a hash, rather than calling the formatting methods afterwards. But the option is there to call the specific format methods for as you need them. I will demonstrate both ways in the examples.

#This will create a christmas colored landscape with snow in the background represented as dots.
my %props = ( color =&gt; &#39;red&#39;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;size =&gt; &#39;20&#39;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bg_color =&gt; &#39;green&#39;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;pattern =&gt; 18,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;align =&gt; &#39;center&#39;,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
my $format = $workbook-&gt;add_format( %props );
#write welcome text with formatting to top left cell
$xmas-&gt;write( &#39;A1&#39;, &#39;Merry Christmas!&#39;, $format);
#Set the column width.
$xmas-&gt;set_column(&#39;A:A&#39;, 30);

You will need to pass the format object to your write method as a parameter:

$merry-&gt;write( &#39;A1&#39;, &#39;Merry Christmas!&#39;, $format );

You might notice the set_column() method, this takes the column 'coordinates' as a parameter and a number which is the actual width. Let's add some more format objects for later.

my $format2 = $merry-&gt;add_format();

#Setting format using formatting methods, red and bold text, green background, center alignment, green background and dotted borders (for the snowflakes)

$format2-&gt;set_color( &#39;red&#39; );
$format2-&gt;set_bold();
$format2-&gt;set_size( 12 );
$format2-&gt;set_bg_color( &#39;green&#39; );
$format2-&gt;set_align( &#39;center&#39; );
$format2-&gt;set_border( 4 );

#Just some snowflakes as border
my $format3 = $merry-&gt;add_format( border =&gt; 4,);

Writing data into cells

There are two ways to do that: you can use either the row-column notation or the A1 notation as described in Cell notation. First of all we need some data so let's compose our cookies list. We will use a hash of array refs to do this:

my $cookies = { 
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Hungary =&gt; [ &#39;bejgli&#39;, &#39;h&oacute;labda&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Scandinavia =&gt; [ &#39;Pepparkakor&#39;, &#39;Ruiskakut&#39;, &#39;Lussekatter&#39;, &#39;Krumkake&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Netherlands =&gt; [ &#39;Spekulaas&#39;, &#39;Kerstkranjes&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Germany =&gt; [ &#39;Lebkuchen&#39;, &#39;Stollen&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Switzerland =&gt; [ &#39;Basler L&auml;ckerli&#39;, &#39;Brunsli&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Italy =&gt; [ &#39;Panettone&#39;, &#39;Pignoli&#39;, &#39;Cannoli&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Spain =&gt; [ &#39;Polvorones&#39;, &#39;Mantecados&#39;, &#39;Turr&oacute;n&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Greece =&gt; [ &#39;Melomakarona&#39; ],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;};
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
#Sort the countries alphabetically
my @countries = sort keys %$cookies;

#Add the cookies to the baking sheet, one country per column.
$baking_sheet-&gt;set_column( 0, scalar keys %$cookies, 15 );
$baking_sheet-&gt;write( &#39;A1&#39;, \@countries, $format2 );

my $i = 0;
for ( sort keys %$cookies ) {
&nbsp;&nbsp;#Place Your cookies to the baking sheet
&nbsp;&nbsp;$baking_sheet-&gt;write( 1, $i, [ $cookies-&gt;{$_} ], $format3 );
&nbsp;&nbsp;$i++;
}

#write some statistics about how many types of cookies we have per country
$stats-&gt;write( &#39;A1&#39;, [ \@countries ], $format2 );

#Reset the counter
$i = 0;
#count how many cookies we have country wise.
for ( sort keys %$cookies ) {
&nbsp;&nbsp;#Place Your cookies to the baking sheet
&nbsp;&nbsp;$stats-&gt;write( $i, 1, scalar @{$cookies-&gt;{$_}} , $format3 );
&nbsp;&nbsp;$i++;
}

Many things are happening here.

First we get a list of countries sorted alphabetically. Second we are writing those countries into the first row, alongside some formats, defined above. Then comes the first usage of write(), where we are using the A1 notation to start from the top left corner, then comes the reference to the @countries array, followed by the format2. When we pass an array reference to write(), it will write the elements of the array in the same row. It is equivalent to write_row(). If you pass an array ref of array refs to write(), it is the same as calling write_col(), it will write to the columns, as demonstrated in the lines 22 and 27.

For more on write(), please check the write section on the module's page.

Outro

Santa was cheerful about this guide, especially that it contains the long avaited Christmas cookie statistics. And perhaps the next task will be to extend this report with more Christmas cookies from around the world.

We just scratched the surface of Excel::Writer::XLSX with this short tutorial. You can find a comprehensive guide on CPAN, Excel::Writer::XLSX. This is a very useful and powerful module, which can deal with a range of tasks from the basics of generating reports to the heavy lifting of the work with VBA in Excel. To cover all of its features would take a whole book.

You can find the whole script on my Github cookies_test.pl, so that you can test it on your own and play with the module. Merry Christmas!

How to wrap a camel?

2022-12-25T00:00:00Z

How to wrap a camel?

In the elf workshop, elves never knew what to do when they were passed a camel and were instructed to wrap it to put it on Santa's sleigh. Many times the elves skipped wrapping and loaded camels right onto the sleigh. This practice garnered the North Pole many letters from children around the world being unable to install and use their new camel! "How do I install Perl?", "cpanm: command not found", "Permission denied", "collect2.exe: error: ld returned 1 exit status", "Can't locate" they cried out for help. Some gift recipients even refused to install their camel despite their needs and desires, as they didn't want to deal with the difficulties of installing Perl. Claus tasked master elf, Artie, to design a fool-proof way of wrapping a camel for enjoyment by children across the world.

Artie got right to work as they knew from experience that wrapping a camel was not a trivial task. First, Artie attempted to wrap a camel with PAR::Packer, but discovered that the wrapped camel was unusable when the user's glibc version or operating system differed from the one Artie used to wrap. Artie knew Santa had high standards and would want a more robust solution, so they continued to do research. Artie stumbled upon the Cosmopolitan Libc and Actually Portable Executables. What if you built a single binary version of Perl that runs on six operating systems and melded your camel to the binary? Then, everyone can use camels! Artie got to work creating Actually Portable Perl (APPerl) with the Perl::Dist::APPerl package for building APPerl and wrapping camels with it.

Close to Christmas, Artie finally had Perl::Dist::APPerl ready and notified Santa. Santa requested an immediate demonstration to determine if it is a viable way of wrapping camels starting this Christmas season.

Wrapping Pure Perl camels

Artie created some directories to contain the camel project.

    mkdir -p wrap_camel/src wrap_camel/script
    cd wrap_camel

Artie created an example script and saved it to script/cameltype:

sub cancel_christmas { die &quot;$!&quot;; }
my $numhumps;
while(1) {
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;How many humps?\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;$numhumps = &lt;STDIN&gt; or cancel_christmas();
&nbsp;&nbsp;&nbsp;&nbsp;chomp $numhumps;
&nbsp;&nbsp;&nbsp;&nbsp;last if($numhumps =~ /^\d+$/);
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Your nose ain't too bright, $numhumps is not a number\n&quot;;
}
my %results = (1 =&gt; &quot;Dromedary\n&quot;, 2 =&gt; &quot;Bactrian\n&quot;);
print($results{$numhumps} // &quot;Maybe a reindeer? Probably not a camel!\n&quot;);

Artie noted to Santa that Pure Perl scripts can be wrapped with an existing version of APPerl, off the shelf builds of APPerl can be found on the APPerl webpage.

Artie picked perl-small.com off the shelf and created an APPerl project:

    wget -O src/perl.com &#39;https://github.com/G4Vi/Perl-Dist-APPerl/releases/latest/download/perl-small.com&#39;
    chmod +x src/perl.com
    apperlm init --name default_config

Artie edited default_config in the newly created apperl-project.json to copy in the cameltype script and set the destination executable name to cameltype.com, the name is important as argv[0] is used to determine which script embedded in APPerl to run.

    &quot;dest&quot; : &quot;cameltype.com&quot;,
    &quot;zip_extra_files&quot; : { &quot;bin&quot; : [&quot;script/cameltype&quot;] },

Artie wrapped the camel and demonstrated the cameltype binary:

    apperlm build
    ./cameltype.com

Santa said, "Ho, ho, ho. Very impressive, Artie! What about the camels with XS modules?"

Wrapping camels with XS modules

Artie said, "Camels with XS modules can also be wrapped into APPerl. However, every XS-wrapping elf needs a Linux build environment." Santa, a big fan of developing on several platforms, asked, "Why is that required?" Artie replied, "While APPerl binaries are also ZIP files, APPerl binaries are statically linked, so there is no way to add binary modules after compilation. To wrap with XS modules, the Cosmopolitan Libc and Perl must be built from scratch." Santa was reasonably worried about this and asked Artie to show him once more.

Artie ran some commands to create a new APPerl project and install build dependencies:

    mkdir -p ../wrap_xs_camel/script
    cd ../wrap_xs_camel
    apperlm install-build-deps
    apperlm init --name default_config --base v5.36.0-small-v0.1.0

Artie created MerryChristmas.xs:

#define PERL_NO_GET_CONTEXT
#include &quot;EXTERN.h&quot;
#include &quot;perl.h&quot;
#include &quot;XSUB.h&quot;
#include &lt;stdio.h&gt;

MODULE = MerryChristmas    PACKAGE = MerryChristmas

void
merry_christmas()
&nbsp;&nbsp;&nbsp;&nbsp;CODE:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf(&quot;Merry Christmas from XS!\n&quot;);

Artie created MerryChristmas.pm:

package MerryChristmas;
our $VERSION = '0.0';
require XSLoader;
XSLoader::load(&quot;MerryChristmas&quot;, $VERSION);
1;

Artie created a script/merrychristmas to demo the module:

use MerryChristmas;
MerryChristmas::merry_christmas();

Artie edited default_config in apperl-project.json to add the MerryChristmas module to the Perl repo, copy in the script, and set the destination executable name.

    &quot;dest&quot; : &quot;merrychristmas.com&quot;,
    &quot;perl_repo_files&quot; : { &quot;ext/MerryChristmas&quot; : [&quot;MerryChristmas.pm&quot;, &quot;MerryChristmas.xs&quot;]},
    &quot;+MANIFEST&quot; : [&quot;__perlarchlib__/MerryChristmas.pm&quot;, &quot;bin/merrychristmas&quot;],
    &quot;+perl_onlyextensions&quot; : [&quot;MerryChristmas&quot;],
    &quot;zip_extra_files&quot; : { &quot;bin&quot; : [&quot;script/merrychristmas&quot;] }

Artie checked out the config, configured, built, and tested out the Merry Christmas message contraption:

    apperlm checkout default_config
    apperlm configure
    apperlm build
    ./merrychristmas.com

Santa said, "Great work, now we can wrap camels of all shapes and sizes to spread cheer to the world! I'd like to put this into practice immediately". Artie replied, "Thank you Santa, I'll get to work teaching all the other elves how to wrap a camel."

Looking at the Christmas Numbers

2022-12-24T00:00:00Z

All the elves know: it is mainly about spreading joy. But some numbers need to be kept in check - maybe with bar charts.

Get some code

Because they is no time for a long coding session during the jolly season, they just grab some example from Chart::Manual::Types. Every line of it is explained there in detail. Once the code is pasted, they change the first dataset (animal names => gift recipients) and paste into the following sets (rows) the real numbers. At last axis and legend need to be labeled properly and a first draft is ready:

use Chart::Bars;
my $g = Chart::Bars-&gt;new( 600, 600 );
$g-&gt;add_dataset( qw/ Peter Paul Mary/ );
$g-&gt;add_dataset( 30, 40, 80 );
$g-&gt;add_dataset( 80, 60, 30 );
$g-&gt;add_dataset( 50, 30, 60 );
$g-&gt;set(
&nbsp;&nbsp;&nbsp;&nbsp;title         =&gt; 'Christmas Expenses',
&nbsp;&nbsp;&nbsp;&nbsp;x_label       =&gt; 'Recipient',
&nbsp;&nbsp;&nbsp;&nbsp;y_label       =&gt; 'Amount',
&nbsp;&nbsp;&nbsp;&nbsp;legend_labels =&gt; ['2020', '2021', '2022'],    
&nbsp;&nbsp;&nbsp;&nbsp;y_grid_lines  =&gt; 'true',
&nbsp;&nbsp;&nbsp;&nbsp;min_val       =&gt;  0,
&nbsp;&nbsp;&nbsp;&nbsp;precision     =&gt;  0,
&nbsp;&nbsp;&nbsp;&nbsp;colors =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y_grid_lines =&gt; 'gray70',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;misc         =&gt; 'gray55',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;text         =&gt; 'gray55',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;x_label      =&gt; 'gray40',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y_label      =&gt; 'gray40',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;title        =&gt; 'gray20',
&nbsp;&nbsp;&nbsp;&nbsp;},
);
$g-&gt;png(&quot;bars1.png&quot;);

The values under the Hash-key colors just gray out the less important parts, so that the chart is more pleasant.

Finding Colors

The only issue now are the dataset colors, which are optimized for contrast (they scream). Intuitive would be to have shades of the same color to signify that neighbouring bars are about the same person, only some numbers are older than others. To achieve that let's pick some appealing color from the table in the lower half of Graphics::Toolkit::Color::Constant. I like 'royalblue3' of the CSS standard. It also has the advantage of providing a workable gradient (list of shades) for free. So just add:

colors =&gt; { ...
&nbsp;&nbsp;&nbsp;&nbsp;dataset0     =&gt; 'royalblue4',
&nbsp;&nbsp;&nbsp;&nbsp;dataset1     =&gt; 'royalblue3',
&nbsp;&nbsp;&nbsp;&nbsp;dataset2     =&gt; 'royalblue2',
},

The only counterintuitive part of this code is to understand that the first add_dataset only adds X-axis labels and the following add_dataset is dataset0.

Customize Colors

Good, but much of the Christmas business reacts to what was last year. How do we highlight a certain dataset with a more red'ish color, while still keeping saturation and lightness in the targeted scheme of the gradient we had before? For that we load the whole toolkit (a direct dependency of Chart) and import also the helper function color, to keep it all short and sweet.

use Graphics::Toolkit::Color 'color';
...

&nbsp;&nbsp;&nbsp;&nbsp;colors =&gt; { ...
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;color('royalblue3')-&gt;add( { Hue =&gt; -220 } ),

Please make sure to have atleast the version 1.03 installed to use that feature.

Open the Color Factory

Normal people would be good now, but what would a super picky designer, who just came from the New York Fashion Week say? Maybe something like: how lame - I want a gradient from Glacier Lake to Harbor Blue. Alright - let's check quickly if Graphics::ColorNames::PantoneReport is installed by grep 'ing the result of Graphics::ColorNames::all_schemes and if so, create our own three color gradient with the colors from this summers Pantone Report. (Other standards like X, HTML or VACCC are available too - just look at Bundle::Graphics::ColorNames).

my @gradient = color('PantoneReport:Glacier Lake')
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt;gradient_to('PantoneReport:Harbor Blue', 3);
&nbsp;...
&nbsp;&nbsp;&nbsp;&nbsp;colors =&gt; { ...
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dataset0     =&gt; $gradient[0],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dataset1     =&gt; $gradient[1],
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dataset2     =&gt; $gradient[2],

If more datasets are present - just increase the second argument of the method gradient_to.

When grouping the values by year instead of recipient, we have to switch X-axis and legend labeling and transpose the data. But also change the colors since they have now to express the difference between people. This does not fit on a linear scale because every human has many different qualities. But the colors still have to go together well to create a harmonious chart. For that task you can create complementary colors, which are maximally different in hue, but same in lightness and saturation (unless the advanced arguments of the method complementary are used).

my @gradient = color('lapisblue')-&gt;complementary( 3 );

Graphics::Toolkit::Color still holds some more options, but that was enough to get a taste for whats possible.

Conclusion

With Graphics::Toolkit::Color you can quickly color you chart after your liking. Check all example code and images here.

At the Present Factory

2022-12-23T00:00:00Z

Father Christmas is very old-school and so is his Perl code. There are no towering software engineering marvels - just a bunch of wonderful scripts: small, meticulously written, very readable and changeable. And because there are so well organized, his system scales up to billions of cheering children.

Reporting about such a high volume of numbers has to be graphical - charts are needed. They are getting mass produced by scripts that convert one dataset into one chart of a particular layout and design by a call like:

perl script.pl data.tsv &gt; chart.png

This approach allows maximal flexibility since source and target names are set from the outside and the scripts don't have to be adapted, even if the data comes from a database or a web scraper. But how to write such a converter script?

Establishing the Pipe

Basic examples can be found under Chart::Manual::Types. But the code there only uses inline data added by the add_dataset method. In our case we have to use add_datafile, which accepts file names or handles and loads an entire table of space or tab separated values (empty rows and perl style comments ignored). Here a short example with only three data rows:

Peter Paul Mary
30    40   80 
80    60   30 
50    30   60

You can produce such files with Text::CSV by setting the property sep_char to ' ' (0x20) or "\t" (0x09). Or you update to Chart 2.403.9 or later and use pure CSV.

The names of the first row are of course X-axis-labels, but Chart takes care of that automatically and recognizes the following three rows as dataset0 .. dataset2. So let's look at the entire code:

use Chart::Lines;

my $file = shift;
my $g = Chart::Lines-&gt;new( 600, 600 );
$g-&gt;add_datafile( $file );

$g-&gt;set(
&nbsp;&nbsp;&nbsp;&nbsp;title          =&gt; 'Latest Numbers !',
&nbsp;&nbsp;&nbsp;&nbsp;include_zero   =&gt; 'true',
&nbsp;&nbsp;&nbsp;&nbsp;y_grid_lines   =&gt; 'true',
&nbsp;&nbsp;&nbsp;&nbsp;precision      =&gt; 0,
&nbsp;&nbsp;&nbsp;&nbsp;colors =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y_grid_lines =&gt; 'gray60',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;misc         =&gt; 'gray55',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;text         =&gt; 'gray55',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;x_label      =&gt; 'gray40',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y_label      =&gt; 'gray40',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;title        =&gt; 'gray20',
&nbsp;&nbsp;&nbsp;&nbsp;},
);

binmode STDOUT;
print STDOUT $g-&gt;scalar_png;

The last two code lines put the image binary into the command line, so after

perl ./script.pl data.tsv &gt; chart.png

.. we get the chart in an image file of our choosing.

Data Set Manipulation

To take full advantage of this setup, our script should automatically adapt to different data set sizes. For that we have to get hold of the data, transform as needed and put it back in. It is simply a reference to an array of arrays.

...
$g-&gt;add_datafile( $file );
my $data = $g-&gt;get_data;
$g-&gt;clear_data;
...
# data transform
...
$g-&gt;add_dataset( $_ ) for @$data;
...
$g-&gt;set(
...

This for instance would allow us to create color gradients or wheels of complementary colors of needed size matching the size of the dataset. How this works I already showed in a previous calendar leaf. But to give another practical example - wouldn't it be nice to have data tables like:

o     Peter Paul Mary
2020  30    40   80 
2021  80    60   30 
2020  50    30   60

The o symbol or any other placeholder is important because Chart gets unhappy quickly when rows are of unequal length - even we pull out the first column before drawing. With this little preprocessing the first column of our data table is now appearing in the legend of the chart.

...
$g-&gt;add_datafile( $file );
my $data = $g-&gt;get_data;
$g-&gt;clear_data;
my @label = map {shift @$_ } @$data;
shift @label;
$g-&gt;add_dataset( $_ ) for @$data;
$g-&gt;set(
&nbsp;&nbsp;&nbsp;&nbsp;legend_labels =&gt; \@label,
...

Voilà, our chart factory is humming away peacefully.

Conclusion

Little scripts can produce piles of charts that are well labeled and and designer-colored, even if the incoming data sets have various sizes. Check all example code and images here.

Building the Sleigh While Flying It

2022-12-22T00:00:00Z

Building the Sleigh While Flying It

"B, a little help?" Santa's voice echoed through the toymaker's headquarters, its pitch a little higher than usual. Binky the Elf left her station and cracked open the boss's door. "What's up, Nick?" she replied, nonchalantly. Santa was squinting at the monitor in front of him, where several lines of error messages kept flooding the terminal.

"I think there's something wrong with the reindeers."

The famous Christmas Reindeers are, of course, robots. As a lover of all living things, Santa could never bring himself to force animals into such a strenuous journey each year. Besides, how else do you think they can travel that fast?

Binky sighed and glanced over Santa's right shoulder. The world population had just surpassed 8 billion, so they had to spend a good part of the year profiling and optimizing the reindeers' code for speed. "I thought you tested it back at All Hallows Eve", the elf cried. Santa looked down, his face redder than his coat. "I was going to, but Jack took me trick or treating instead", he muttered.

Binky raised an eyebrow. With that kind of care, it was a Christmas Miracle this code compiled in the first place. Thinking of the kids, she decided not to pursue the argument and instead put her energy into finding and fixing the issue. The error messages were cryptic, at best:

    
    Undefined subroutine &Class::MOP::Class:::after called at /home/santaclaus/.plenv/versions/5.36.0/lib/perl5/site_perl/5.36.0/x86_64-linux/Class/MOP/Method/Wrapped.pm line 57.
    Reindeer::Prancer::_wrapped_dash_away(Reindeer::Prancer=HASH(0x1383a6160)) called at /home/santaclaus/.plenv/versions/5.36.0/lib/perl5/site_perl/5.36.0/x86_64-linux//Class/MOP/Method/Wrapped.pm line 97
    Reindeer::Prancer::dash_away(Reindeer::Prancer=HASH(0x1383a6160)) called at christmas.pl line 1225

"Huh.", the elf frowned. Reindeers were controlled by complex Moose classes, but method modifiers such as 'before', 'after' and 'around' were pretty standard. It made no sense that "after" was not defined. Line 1225 of christmas.pl, was also pretty straightforward:

$reindeer-&gt;dash_away();

Binky and Santa spent a little while staring at the source code. Everything looked fine, but the code was still failing. Finally, Binky broke the silence: "Did you try dumping $reindeer before that call?" she suggested. "I did, but look!", the old man scrolled up the terminal window and pointed at a line that said:

        $VAR1 = bless( {}, &#39;Reindeer::Prancer&#39; );

"It's just showing the bless() command, an empty hash reference and the class name. How am I supposed to work with that?" Santa whimpered. "That's because you're using Data::Dumper, boss." A faint smile crept into Binky's lips. It wasn't every day she was able to teach Father Christmas himself something new. She continued. "Data::Dumper is best for serializing. If you want to inspect the data yourself, you should use Data::Printer instead."

Santa Claus' eyes widened. "Data::Printer? What kind of sorcery is that?" The elf signaled him to scooch over so she could reach the keyboard herself. As she typed cpanm Data::Printer, she said: "It's a module that dumps variables in a way meant to be read by an actual human trying to debug code. Don't worry, it's super light and fast - zero deps and all. See? It's already installed." Then she fired up the editor and replaced the line that said:

use Data::Dumper; say Dumper($reindeer);

with:

use DDP; p $reindeer;

They gave it another go and the result was quite different:

    
    Reindeer::Prancer  {
         parents: Reindeer
         roles (1): FlyingMagic
         attributes (2): name, sleigh
         public methods (24):
             dash_away, DESTROY, meta, new
             Carp:
                 confess
             Class::MOP::Class:
                 :after
             FlyingMagic:
                 liftoff
             Moose:
                 after, around, augment, before, extends, has, inner, override, super, with
             Moose::Object:
                 BUILDALL, BUILDARGS, DEMOLISHALL, does, DOES, dump
             Scalar::Util:
                 blessed
         private methods (1): _build_name
         method modifiers (1):
             after dash_away &lt;undefined coderef&gt;
         internals: {}
     }

The terminal lit up like a Christmas Tree. They could see the full class hierarchy, applied roles, attributes, public and private methods - everything! Santa's eyes sparkled. "Ho! Ho! Ho! I know what's wrong." He pointed at the line that said after dash_away: <undefined coderef> in bright red. They searched the source code for 'after "dash_away"' and quickly found the only entry, that read:

after 'dash_away' =&gt; \&amp;lifftoff;

They took another look at the Data::Printer output searching for that method. Santa quickly spotted it coming from the FlyingMagic role, but it was written differently. "A typo! Someone was naughty on that code review." They fixed the typo and ran it again. It worked! One by one the reindeers started whirring. Santa was about to jump on the sleigh for a final test-drive when the elf interrupted the program. "What is it, B?" the old man asked.

Binky was staring at the terminal again. "It's leaking memory. The way things are, the sleigh will crash before you even reach the Atlantic. Hold on." The elf added a bunch of p() statements throughout the code. Santa Claus looked bewildered. "What are you doing? There will be so much stuff in the output we won't be able to make any of it out!", he scoffed.

"Sure we will." Binky replied without taking her eyes off the monitor. "We'll control what prints what on the .dataprinter file". She created a new file called ".dataprinter" on the root of the project path, then made it look something like this:

    
    show_refcount = 1
    theme = Material

    [Sleigh::Engine]
        class.expand = 0
    
    [Toys::Storage::MagicBag]
        filters = DB
    
    [Reindeer]
        class.stringify = 0
        class.show_wrapped = 0
        class.inherited = none
        output = /var/log/christmas/reindeer.data

Binky went on to explain that you could place global settings for Data::Printer at the top of that file, like setting a theme and showing refcounts, then create more specific rules that apply only to certain caller packages. In this case, any p() statements made inside Sleigh::Engine would not expand objects, showing only the class name and (as per the global setting) the refcount. On the other hand, calls to p() inside Toys::Storage::MagicBag would be subject to all the filters set on Data::Printer::Filters::DB, useful to see database connection statuses, prepared statements, result sources and sets from DBI, DBIx::Class and more.

Finally, calls to p() made inside Reindeer.pm would not attempt to stringify objects that have a subroutine as_string, to_string or similar, nor will they show wrapped method modifiers or methods inherited from parent classes. Even so, that particular output is in a hot codepath and can get pretty big, so instead of printing to STDERR, it will write to the custom /var/log/christmas/reindeer.data file.

"We could even put all those settings in a custom profile package and upload it to CPAN or whatever, but right now a .dataprinter file is more than enough." They tried running the program again and, sure enough, the output read:

    
    Sleigh (refcount: 10)
    Sleigh (refcount: 10)
    Sleigh (refcount: 10)

Santa was puzzled. "10 refcounts on the sleigh? We must have a circular reference somewhere. What's going on on that Reindeer log file?" Binky opened it, but it looked pretty much the same: several reindeer objects just like before, except this time without the inherited methods but with a refcount next to each data, just like they asked:

    
    Reindeer::Vixen  {
         parents: Reindeer
         roles (1): FlyingMagic
         attributes (2): name, sleigh
         public methods (4):
             dash_away, DESTROY, meta, new
         private methods (1): _build_name
         internals: {
             sleigh    Sleigh (refcount: 10)
         }
     }

Santa sighed. "If only that Data::Printer of yours could signal weak references..." Binky's eyes widened as she stared at him. "Nick, you're a genius!" The old man chuckled. "Me? What did I do?" The elf went on. "Data::Printer DOES show when it's looking at a weak ref. The fact that we don't see it means that Sleigh object right there was NOT weakened." They opened the reindeer class in the editor and replaced the line that read:

has 'sleigh', is =&gt; 'rw', isa =&gt; 'Sleigh';

with:

has 'sleigh', is =&gt; 'rw', isa =&gt; 'Sleigh', weak_ref =&gt; 1;

They fired up the program again. The reindeers whirred and clanked for a few seconds, then Rudolph's nose lit up, signaling the restart was complete and they were all ready to fly. Santa's heartbeat kicked up a notch as Binky opened the logs to see what it showed:

    
    Reindeer::Vixen  {
         parents: Reindeer
         roles (1): FlyingMagic
         attributes (2): name, sleigh
         public methods (4):
             dash_away, DESTROY, meta, new
         private methods (1): _build_name
         internals: {
             sleigh    Sleigh (weak)
         }
     }

The sleigh references were weak and no refcount was showing. "Yes!" the elf fell back into her chair and breathed a sigh of relief. "Do we remove the p() statements now that everything is fine?" asked Santa. "We can, sure - but if you think they're in good debugging spots you can just add quiet = 1 to each section of the .dataprinter file and any calls to p() will quickly return not printing anything. We can even add a live_update = 1 and Data::Printer will automatically watch the .dataprinter file and reload it whenever we change it without needing to restart the program."

The old man thanked his friend as she rose up to leave. Binky was almost at the door when she turned and realized Santa was still at the computer. "You're gonna play with the output colors and make a new theme for Data::Printer now, aren't you?"

Santa grinned. This was going to be a Merry Christmas after all.

Lapland Packaging Department - Part 2

2022-12-21T00:00:00Z

After getting to work on his second day, Tonttu quickly downloaded the Carton module's tarball. This was the chosen module to make the installation and packaging of other modules and projects easier.

Carton is capable of dependency handling, can download the source tarballs for modules and last but not least, can create a portable package for any project. This package can be copied to any machine and Carton will install all modules automatically, without the need for an internet connection. The nisse started to do some testing and cooked up the following proof of concept for Santa for the first part:

Tonttu made sure first, that Carton is installed on all servers in the warehouse. He used the manual compilation method he had jotted down the day before.

After that he wrote the following guide for his busy elf colleagues:

Task 1. - Preparing the distribution

Create a cpanfile for your project, listing all the used modules (of course only the ones not part of the Perl core, but installed extra). List the minimum required Perl version for your project (if any) in the first line.

# cpanfile
requires &#39;perl&#39;, &#39;5.20.0&#39;;
requires &#39;Getopt::Long&#39;;
requires &#39;Data::Dumper&#39;;
requires &#39;Log::Log4perl&#39;;
requires &#39;MIME::Lite&#39;;
requires &#39;MIME::Types&#39;;
requires &#39;Mail::Address&#39;;
requires &#39;Net::SCP&#39;;
requires &#39;JSON&#39;;
requires &#39;DBI&#39;;
requires &#39;Excel::Writer::XLSX&#39;;

As you can see, only a handful of modules are in there, Carton will automatically take care of the dependencies.

Next step is to carton install the modules inside the local/ directory.

$ carton install
Installing modules using /home/cabox/workspace/projects/test_carton/cpanfile
Successfully installed Archive-Zip-1.68
Successfully installed Excel-Writer-XLSX-1.09
Successfully installed Net-SSH-0.09
Successfully installed String-ShellQuote-1.04
Successfully installed Net-SCP-0.08
5 distributions installed
Complete! Modules were installed into /home/cabox/workspace/projects/test_carton/local

Notice that after this step a file named cpanfile.snapshot has been generated, with all the modules and dependencies managed by Carton. As You can see from the below example there are way more modules in this file than in our list in the cpanfile:

$ cat cpanfile.snapshot
# carton snapshot format: version 1.0
DISTRIBUTIONS
&nbsp;&nbsp;Archive-Zip-1.68
&nbsp;&nbsp;&nbsp;&nbsp;pathname: P/PH/PHRED/Archive-Zip-1.68.tar.gz
&nbsp;&nbsp;&nbsp;&nbsp;provides:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::Archive 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::BufferedFileHandle 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::DirectoryMember 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::FileMember 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::Member 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::MemberRead 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::MockFileHandle 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::NewFileMember 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::StringMember 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::Tree 1.68
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip::ZipFileMember 1.68
&nbsp;&nbsp;&nbsp;&nbsp;requirements:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Compress::Raw::Zlib 2.017
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Encode 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ExtUtils::MakeMaker 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Basename 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Copy 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Find 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Path 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Spec 0.80
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Temp 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IO::File 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IO::Handle 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IO::Seekable 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Time::Local 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl 5.006
&nbsp;&nbsp;Excel-Writer-XLSX-1.09
&nbsp;&nbsp;&nbsp;&nbsp;pathname: J/JM/JMCNAMARA/Excel-Writer-XLSX-1.09.tar.gz
&nbsp;&nbsp;&nbsp;&nbsp;provides:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Area 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Bar 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Column 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Doughnut 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Line 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Pie 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Radar 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Scatter 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chart::Stock 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Chartsheet 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Drawing 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Examples 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Format 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::App 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Comments 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::ContentTypes 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Core 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Custom 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Metadata 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Packager 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Relationships 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::SharedStrings 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Styles 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Table 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::Theme 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::VML 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Package::XMLwriter 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Shape 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Utility 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Workbook 1.09
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Excel::Writer::XLSX::Worksheet 1.09
&nbsp;&nbsp;&nbsp;&nbsp;requirements:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Archive::Zip 1.3
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ExtUtils::MakeMaker 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;File::Temp 0.19
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IO::File 1.14
&nbsp;&nbsp;Net-SCP-0.08.reprise
&nbsp;&nbsp;&nbsp;&nbsp;pathname: I/IV/IVAN/Net-SCP-0.08.reprise.tar.gz
&nbsp;&nbsp;&nbsp;&nbsp;provides:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Net::SCP 0.08
&nbsp;&nbsp;&nbsp;&nbsp;requirements:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ExtUtils::MakeMaker 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;IO::Handle 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Net::SSH 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;String::ShellQuote 0
&nbsp;&nbsp;Net-SSH-0.09
&nbsp;&nbsp;&nbsp;&nbsp;pathname: I/IV/IVAN/Net-SSH-0.09.tar.gz
&nbsp;&nbsp;&nbsp;&nbsp;provides:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Net::SSH 0.09
&nbsp;&nbsp;&nbsp;&nbsp;requirements:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ExtUtils::MakeMaker 0
&nbsp;&nbsp;String-ShellQuote-1.04
&nbsp;&nbsp;&nbsp;&nbsp;pathname: R/RO/ROSCH/String-ShellQuote-1.04.tar.gz
&nbsp;&nbsp;&nbsp;&nbsp;provides:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;String::ShellQuote 1.04
&nbsp;&nbsp;&nbsp;&nbsp;requirements:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ExtUtils::MakeMaker 0

Don't forget to exclude the local/ directory and add the files cpanfile and cpanfile.snapshot to your version control system!

At this point we have a package, which is not really portable. To make it portable, run

$ carton bundle
Bundling modules using /home/cabox/workspace/projects/test_carton/cpanfile
Copying P/PH/PHRED/Archive-Zip-1.68.tar.gz
Copying J/JM/JMCNAMARA/Excel-Writer-XLSX-1.09.tar.gz
Copying I/IV/IVAN/Net-SCP-0.08.reprise.tar.gz
Copying I/IV/IVAN/Net-SSH-0.09.tar.gz
Copying R/RO/ROSCH/String-ShellQuote-1.04.tar.gz
Writing /home/cabox/workspace/projects/test_carton/vendor/cache/modules/02packages.details.txt.gz
Complete! Modules were bundled into /home/cabox/workspace/projects/test_carton/vendor/cache
It will bundle your tar archives into the vendor/ directory.

Add vendor to your VCS or don't, it's up to you.

Now we are ready to deploy the package to a different machine.

Task 2: Deploying your Package to the Remote Machines

Copy the whole directory to the desired directory on the target systems.

This is the directory structure you should see (without your own stuff):

.
|-- cpanfile
|-- cpanfile.snapshot
|-- ...  #Your stuff here
|-- ...	 #Your stuff here
`-- vendor
&nbsp;`-- cache
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;|-- authors
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;`-- modules

Now it's time to install the modules using Carton (which has been previously installed by Tonttu):

$ carton install --deployment cached

This will use the module tarballs from the vendor/ directory and create local/ with the installed modules.

If therea are no errors, you may remove the vendor/ directory (optional).

Santa reviewed the proof of concept and was proud of Tonttu for doing such a great job.

After sharing the how-to, all the elves started to use the Carton packaging module and their job got a lot easier.

Santa was cheerful and satisfied, as the whole Packaging Department could fulfill more children's wishes much much faster than before.

Lapland Packaging Department - Part 1

2022-12-20T00:00:00Z

Once upon a time in the far North in Lapland (more precisely in Korvatunturi), Tonttu the nisse joined the Lapland Packaging Department after a successful series of interviews with Joulupukki -- aka Santa -- himself. Tonntu got the challenging task to make the Packaging Department's work more effective. On his very first day in the middle of November he was checking the IT infrastructure in the warehouse. He noticed the network is segmented and only one machine had connection to the internet through a proxy.

There was not much time left until Advent so he decided to stick with Perl, his favourite programming language.

"Perl is capable of everything by itself, anyway", he thought.

Unfortunately there was no chance to use tools like cpan or App::cpanminus only on that single machine connected to the internet. And that connection worked only when the http_proxy and https_proxy were explicitly set beforehand.

First of all he needed a solution to be able to use at least a handful of modules to accomplish his work.

"Why not compile the required modules from source downloaded from CPAN?", he asked himself.

It sounded like a good starting point. He immediately made his hands dirty.

Tonttu quickly jotted down a small how-to:

This method can be used to compile any Perl module manually on Linux!

First of all make sure, that PERL5LIB is loaded. If not, load it with export PERL5LIB=/path/to/your/perl (especially if you have Perl installed to a custom location).

$ echo $PERL5LIB
/home/cabox/perl5/lib/perl5

If the output is empty, that means PERL5LIB is not loaded (most probably Perl is installed into a custom location). So let's load it:

export PERL5LIB=/path/to/your/perl

Second, we need to download the module from CPAN. Let's demonstrate the process with Pod::Advent:

Download the tarball for the installation:

$ wget https://cpan.metacpan.org/authors/id/D/DA/DAVIDRW/Pod-Advent-0.24.tar.gz

Untar the archive:

tar -xzvf Pod-Advent-0.24.tar.gz

Switch to the directory of the module's source:

$ cd Pod-Advent-0.24

Execute Makefile.PL with Perl.

$ perl Makefile.PL
Checking if your kit is complete...
Looks good
Generating a Unix-style Makefile
Writing Makefile for Pod::Advent
Writing MYMETA.yml and MYMETA.json

Then execute make and make install.

$ make
cp lib/Pod/Advent.pm blib/lib/Pod/Advent.pm
cp bin/pod2advent blib/script/pod2advent
&quot;/home/cabox/perl5/perlbrew/perls/perl-5.28.0/bin/perl&quot; -MExtUtils::MY -e &#39;MY-&gt;fixin(shift)&#39; -- blib/script/pod2advent
Manifying 1 pod document
Manifying 1 pod document

$ make install                                                                       
Manifying 1 pod document
Manifying 1 pod document
Appending installation info to /home/cabox/perl5/lib/perl5/x86_64-linux/perllocal.pod

In the case of a more complicated module, tests might fail. You might be presented with errors in the output, or in the worst case, you might face dependency hell. DISCLAIMER: To avoid dependency hell or other errors upon module installation it is recommended to use cpan or cpanm wherever and whenever possible.

Tonttu knew that installing modules this way is cumbersome, but sometimes, in difficult environments, these steps can come handy.

Santa took a look at the how-to and told Tonttu kindly: "Not bad, especially on your first day, but I am sure you are able to improve it. Try to think about extending the solution."

Tonttu went to the community room and started knitting -- that was his favorite hobby and it helped him to think.

After finishing a scarf with red nosed reindeers, the solution was already in his head. Tomorrow he will try it out, but that is already another story.

Find known, reported vulnerabilities in the modules you use

2022-12-19T00:00:00Z

How do you know that you are up-to-date on security advisories for perl and CPAN modules? CPAN::Audit and its cpan-audit program can do that for you:

    % cpan CPAN::Audit
    % cpan-audit installed

You end up with a list of reports of known vulnerabilities for everything in your @INC. Fix some of those by upgrading modules, using a more modern replacement, or, even better fix the problem and send that upstream.

These reports come mostly from MITRE and its library of Common Vulnerabilities and Exposures, or just CVE, that it's developed since 1999. All of this is pre-digested and arranged into CPAN::Audit::DB, which comes with the CPAN::Audit distribution.

Check a module

If you are interested in a particular module, you can check that too. For example, DBI has had several reports over its history:

        % cpan-audit module DBI

          * CPANSA-DBI-2014-01
                DBD::File drivers open files from folders other than
                specifically passed using the f_dir attribute.

                Affected range: &lt;1.632
                Fixed range: &gt;=1.632

                References:
                https://metacpan.org/changes/distribution/DBI
                https://rt.cpan.org/Public/Bug/Display.html?id=99508

          * CPANSA-DBI-2020-01
                A buffer overflow was found in perl-DBI &lt; 1.643 in DBI.xs. A
                local attacker who is able to supply a string longer than 300
                characters could cause an out-of-bounds write, affecting the
                availability of the service or integrity of data.

                Affected range: &lt;1.643
                Fixed range: &gt;=1.643

                CVEs: CVE-2020-14393

                References:
                https://metacpan.org/changes/distribution/DBI
                https://bugzilla.redhat.com/show_bug.cgi?id=1877409

        ... many more advisories ...

        Total advisories found: 9

Those are the advisories for DBI for the entire history of the Universe, and all of those have been patched already and you don't care about them.

Specify a version to see advisories the apply to just that version. The current version of DBI, 1.643 as I write this, so try that. There are no open (known) vulnerabilities:

        % cpan-audit module DBI 1.643
        No advisories found

That second argument can also be a range, such as >1.600. Ensure that you quote the range since > and < are shell metacharacters:

        % cpan-audit module DBI &#39;&gt;1.600&#39;
        ... eight advisories ...
        Total advisories found: 8

Command-line use is nice, but you're more likely to use this in some automated program to continuously check your installation. The exit code tells you what cpan-audit found. If you get 0, there were no advisories found. If you get a number larger than 64, subtract 64 to get the number of advisories:

        % cpan-audit module DBI &#39;&gt;1.600&#39;
        ... eight advisories ...
        Total advisories found: 8
        % echo $?
        72

How it works

Вячеслав Тихановский (vti on CPAN) created CPAN::Audit to collate information from MITRE (the repository of CVEs), namespace mappings from PAUSE, and version data from MetaCPAN. He put that all together so he could present to you the vulnerabilities in a useful way.

The advisory data are actually kept in a separate repository, cpan-security-advisory. Each advisory references some vulnerability, notes the affected version, and tracks some other information. These are kept in YAML files for each distribution.

CPAN::Audit digests those YAML files to create CPAN::Audit::DB so that each release contains all of the vulnerability data. Once you install CPAN::Audit, perhaps on an isolated machine with no network access, you have everything you need. There's no extra networking, downloading, and so on.

When you run cpan-audit, it selects from that database just the information appropriate for you.

Contribute!

A small group of people are revitalizing CPAN::Audit, and there's always room for more. There's work appropriate for all skill levels.

This project only useful if it has up-to-date and correct data. A large part of the effort involves keeping up-to-date with vulnerabilities, and a lot of that is boring, manual work. Bite off some small chunks to earn some of those [GitHub badges](https://github.com/Schweinepriester/github-profile- achievements). The CONTRIBUTING docs are a good place to start.

We're also looking to revamp how we collate the data to make it easier to work with. We've started tracking vulnerabilities in external libraries, such as bootstrap, that some distributions include. That's not quite ready, but it's getting close.

Finally, you can just use cpan-audit and let us know how it works for you, what else you need to accomplish your task, and how else we can help you track this information. The Discussions section of CPAN::Audit's repo is a good way to give non-issue feedback.

TWVycnkgQ2hyaXN0bWFzIDop

2022-12-18T00:00:00Z

Perl Birthday Party

On the 18th of December, to celebrate Perl's birthday, the elves organized a big party with cakes, waffles, pancakes and maple syrup.

They partied like crazy but only until exactly midnight when everyone went to bed.

The day after, the elves walked to North Pole warehouse. To open the door and disable the alarm, as every day, they called the dedicated elf "Spof" to enter the code. He typed the code and the security LCD printed "ERROR".

- Type it again, said another elf

He proceeded and, once again, got "ERROR".

- We are bad!

Then they looked at Spof, his face was all red and his eyes were all dizzy... They remembered that Spof drank a lot of maple syrup during the past day party, something like 5 glasses. And if you are not aware, elves should drink maple syrup with parsimony because else it drives them mad!

- What is the code? they asked

- TWVycnkgQ2hyaXN0bWFzIDop

- Are you sure?

- WWVz

Deciphering the code

One of the elves has a little experience with IT and he immediately thought he would test MIME::Base64 to translate this gibberish:

use MIME::Base64 qw( decode_base64 );

print decode_base64('TWVycnkgQ2hyaXN0bWFzIDop');

Bingo! He got the code Merry Christmas :) and elves were able to open the warehouse!

Secret is compromised!

But wait, now everyone is aware of the secret code, including you! This is not acceptable!

So some senior elves decided to change the code:

use Env;
use MIME::Base64 qw( encode_base64 );

print encode_base64($ENV{SECRET});

The above script is using an environment variable to pass the secret.

Make perl speak Spof's dialect

Aside from maple syrup, Spof enjoys doing some Perl scripting for himself the evening, so after this event he did (or at least he tried).

Being still confused he tried to write cHJpbnQgIk1lcnJ5IENocmlzdG1hcyA6KSIK but it was not working.

Confused but lazy, he searched the MetaCPAN for a solution and went with Acme::Base64:

use Acme::Base64;

cHJpbnQgIk1lcnJ5IENocmlzdG1hcyA6KSIK

This way, the perl interpreter could understand the base64 dialect spoken by Spof! Magic!

Conclusion

You should never feed Gremlin after midnight but you also need to monitor closely the maple syrup consumption of elves!

Naughty or Nice Networks

2022-12-17T00:00:00Z

The wise old elf was taking a breather from all the busy preparations and was just looking forward to a richly deserved hot toddy when he heard a familiar knock at the door. He allowed himself the briefest of sighs.

"Come in, Wispy!"

In scuttled Wispy Crinkletops wearing a worried expression.

"You know the wonderful new web portal we set up so that people could write to us directly with their wishes? Well, not all the messages received have been about that. Lots are from people looking to sell us things - and mostly useless things at that! And there are some others which are just so ... rude. How could anyone be so mean?"

"Now, now. Don't get all flustered. You know that this sort of thing is why the boss keeps a Naughty List as well as a Nice List.". The wise old elf thought for a moment and then asked, "Did you look to see if these all came from the same IP address?".

Wispy composed herself and then nodded. "I did check but they were from quite a big number of different addresses so it would take forever to try to deal with them all.".

"Hmmm. Can you show me the list?"

Again Wispy nodded and produced a sizeable sheaf of 11 by 14 fanfold. The wise old elf smiled kindly and ran his eyes down the list. Some definite patterns were detectable and he hit upon an idea.

"Even though there are a lot of different addresses, it looks like only a dozen or so netblocks are involved. We can use Net::CIDR::Lite to filter those.". He turned to his terminal and quickly constructed some code. Wispy peered over his shoulder to see.

use CGI::Fast;
use Net::CIDR::Lite;

# Build list of netblocks
my $naughty = Net::CIDR::Lite-&gt;new;
$naughty-&gt;add ($_) for qw{10.52.192.0/18 172.26.64.0/20 192.168.188.0/23};

while (my $fcgi = CGI::Fast-&gt;new) {

    # Test for presence in the list
    if ($naughty-&gt;find ($ENV{REMOTE_ADDR})) {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;triage ($fcgi);
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next;
&nbsp;&nbsp;&nbsp;&nbsp;}

&nbsp;&nbsp;&nbsp;&nbsp;warn &quot;DEBUG: $ENV{REMOTE_ADDR} is not from a known naughty netblock.\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;process_form ($fcgi);
}

sub triage {
	# Push the message onto the moderation queue
	...
}

sub process_form {
	# Not from a known naughty netblock, so assume to be nice
	...
}

The wise old elf explained, "This allows any number of ranges to be combined into a single list for comparison against the client address. You don't need to store every single address in the naughty blocks."

Wispy was impressed but could see one or two problems. "We don't use FCGI for the web form - it's all PSGI now."

"It's only an illustration, Wispy - you can use this method with any handler."

"There were IPv6 addresses in the list too. Can we add those?"

"You would need 2 separate objects to hold v4 and v6 addresses but the principle is the same."

"I can never remember the netmasks, though." moaned Wispy, crestfallen.

The wise old elf smiled. "You don't have to use netmasks, just a simple range will do. You can even mix and match, like this:"

$naughty-&gt;add_any ($_) for qw{10.52.192.0/18 172.26.64.0-172.26.79.255 192.168.188.0/23};

Wispy brightened as she could see that this would save time and effort and keep all those naughty girls and boys where they deserved to be. She thanked the wise old elf and headed off to implement the filter, leaving him to enjoy his hot toddy in peace.

Relocatable Perl

2022-12-16T00:00:00Z

On May 2022, perl v5.36 was released. Now I always write perl with

  use v5.36;

and I'm very excited to use new features.

Unfortunately I don't think too many people use perl v5.36 yet. This is because system perls are often out-of-date, so people don't have many chances to use the latest perl.

It is true that you, an experienced Perl hacker, could build perl v5.36 by yourself. But people who are not very familiar with Perl rarely build perl from source.

Some programming languages, including nodejs and golang, provide their pre-built binaries. This helps people get started and use the latest version of the languages.

So what if perl also provides its pre-built binaries?

Because perl itself does not depend on external libraries (except for glibc on linux, etc.), it seems that we can prepare portable perl binaries for each OS/arch. Additionally, since v5.10, perl can be built with relocatable INC so that we can relocate the perl tree wherever we want.

Well, I prepared pre-built relocatable-perls for

linux amd64
linux arm64
macOS amd64
macOS arm64 (for M1/M2 chips)

Are these useful? Let's give it a try!

Install relocatable-perls

There are 3 ways to install relocatable-perls.

Manually

You can manually download tarballs for your OS/arch from release page. For example, if you use macOS with the M1 chip, then

  $ curl -fsSL -o perl-darwin-arm64.tar.xz https://github.com/skaji/relocatable-perl/releases/latest/download/perl-darwin-arm64.tar.xz
  $ tar xf perl-darwin-arm64.tar.xz
  $ mv perl-darwin-arm64 ~/wherever-you-want
  $ ~/wherever-you-want/bin/perl -v
  This is perl 5, version 36, subversion 0 (v5.36.0) built for darwin-2level

One liner

A helper script perl-install helps you to install relocatable-perls:

  $ curl -fsSL https://raw.githubusercontent.com/skaji/relocatable-perl/main/perl-install | bash -s ~/perl

This installs the latest relocatable-perl into ~/perl.

plenv

If you use plenv, then plenv-download may be useful:

  $ git clone https://github.com/skaji/plenv-download $(plenv root)/plugins/plenv-download
  $ plenv download latest
  Downloading https://github.com/skaji/relocatable-perl/releases/download/5.36.0.1/perl-darwin-amd64.tar.xz
  Unpacking /Users/skaji/env/plenv/cache/relocatable-5.36.0.1/perl-darwin-amd64.tar.xz
  Successfully installed 5.36.0.1

How to use relocatable-perls

You can use relocatable-perls just like your usual perls. I have been using relocatable-perls for 8 years and don't have any particular problems.

Relocatable-perls come with cpanm so that you are ready to use CPAN modules!

  $ cpanm -nq Plack
  $ plackup -p 8080 -e &#39;sub {[200,[],[&quot;hello world!&quot;]]}&#39;
  HTTP::Server::PSGI: Accepting connections at http://0:8080/

Conclusion

I think pre-built binaries helps people get started with perl and use the latest version of perl. I prepared relocatable-perls so that you can give it a try now!

Create Professional Slideshows with Mojolicious::Plugin::RevealJS

2022-12-15T00:00:00Z

Install and run a Mojolicious server

Santa's elf had a problem. He had to write a presentation very fast and show it to a bunch of new elves. The email assigning this to him was sent by Santa himself. The elf started to look on MetaCPAN and found this module: Mojolicious::Plugin::RevealJS

He quickly typed the following commands:

cpanm Mojolicius Mojolicious::Plugin::RevealJS

Now he could generate a Mojo lite app using:

mojo generate lite-app slide_show

Because the elf was trained in the ancient arts of the elders he could open new file with vim and paste this code in:

use Mojolicious::Lite -signatures;
app-&gt;static-&gt;paths(['.']);
plugin 'RevealJS';
any '/' =&gt; { template =&gt; 'presentation', layout =&gt; 'revealjs' };
app-&gt;start;

Then he swiftly created two folders:

    mkdir templates
    mkdir examples

Use html/Markdown to generate content

After that the file for the presentation was generated:

vim templates/presentation.html.ep

Finally he could add his first slides to the presentation using html:

    &lt;section&gt;
    &lt;h4&gt; Create Professional Slideshows with Mojolicious::Plugin::RevealJS&lt;/h4&gt;
    &lt;p&gt;by Trif Dragos&lt;/p&gt;
    &lt;/section&gt;

    &lt;section&gt;
    &lt;h2&gt;About this talk&lt;/h2&gt;
        &lt;ul&gt;
        &lt;li&gt;Install and run a Mojolicius server&lt;/li&gt;
        &lt;li&gt;Configure Mojolicious::Plugin::RevealJS&lt;/li&gt;
        &lt;li&gt;Use html/MarkDown to generate content&lt;/li&gt;
        &lt;li&gt;Add code snippets in your presentation&lt;/li&gt;
        &lt;li&gt;Add notes visible only for the author of the presentation&lt;/li&gt;
    &lt;/ul&gt;
    &lt;/section&gt;

Using the morbo slide_show command he could start the server. Only after that he was able to access the presentation on his local host: http://127.0.0.1:3000

Time was ticking. The elf need to speed things up. So, instead of HTML tags, he used Markdown format:

    %= markdown_section begin
    #### Create Professional Slideshows with Mojolicious::Plugin::RevealJS
    % end

    %= markdown_section begin
    * Install and run a Mojolicius server
    * Configure Mojolicious::Plugin::RevealJS
    % end

For more details on how to do this in Markdown format he used this link: Markdown-Cheatsheet

Add code snippets in your presentation

Finally he wanted to insert code snippets in his work. For this he use the include_code statement which points to the file to include and the correct syntax highlighting to use:

    &lt;section&gt;
    &lt;section&gt;
        %= include_code &#39;examples/test.pl&#39;,  language =&gt; &#39;perl&#39;
    &lt;/section&gt;
    &lt;section&gt;
        %= include_code &#39;examples/app.js&#39;, language =&gt; &#39;javascript&#39; 
    &lt;/section&gt;
    &lt;/section&gt;

Disaster! The examples/test.pl file has too much code in it. The new elves will be lost forever if they see this. He opened the file and added some magic comments to it:

use strict;
use warnings;

use lib 'lib';

use Foo;
use feature 'say';

# reveal begin object_creation
my $o = Foo-&gt;new();
# reveal end object_creation

$o-&gt;print_foo_bar();
$o-&gt;test(1);
say $o-&gt;test();

say $o-&gt;test();

After the section key was added to the include_code statement:

%= include_code 'examples/test.pl', language => 'pl', section => 'object_creation'

Only this line my $o = Foo->new(); between those comments was visible in the presentation.

Add notes visible only for the author of the presentation:

Finally he added some notes to each slide:

    &lt;section&gt;
    &lt;h4&gt; Create Professional Slideshows with Mojolicious::Plugin::RevealJS&lt;/h4&gt;
    &lt;p&gt;by Trif Dragos&lt;/p&gt;
    %= markdown_section begin
    Note:
    my notes
    %end
    &lt;/section&gt;

Now when he pressed s, he could see the notes from each slide in a new window, which also allowed him to control his presentation.

Bibliography:

Create professional with App revealup
Advanced slideshow maneuvers

Let the Elves Import Your Packages

2022-12-14T00:00:00Z

Same as every year, the last few days before Christmas are very busy for the Elves. Those little tinkers are best known for hand-crafting all the presents kids dreamed of, but they also run small but repetitive errands for Santa.

Did you know he doesn't need to manually import every single Perl package he has written? Yep, elves do that for him. It's effortless - he just whispers the namespace and his little helpers take care of the rest.

At around 2003, Santa managed to spy on the Elves to figure out how they do it. In his infinite generosity, he shared their method with some Perl module authors who later refined it. It was released to the world as EaaPM (Elves as a Perl Module) named all. Fourteen long years have passed since the method was perfected and Santa can still use this module without any issues, thanks to Perl's excellent backwards compatibility.

So, what was the method you might ask? Simple. You just had to write use all 'NAMESPACE'; and busy elves would go through your @INC recursively and import everything they found under that namespace. They had one significant limitation though - no matter how much they practiced, they couldn't get the hang of importing symbols into the caller. You could tell it just wasn't their thing.

How can you benefit from the module? Let's say you have packages, which are all classes:

use Present::Toy;
use Present::ElectronicDevice;
use Present::BoardGame;
use Present::SportsEquipment;
use Present::Candy;
use Present::Book;

You can just replace all of those lines with one of the following, which will all do the same:

use all 'Present';
use all 'Present::*';
use all of =&gt; 'Present';

It's Straightforward, Stable and Santa-approved - 'S' x 3!

Before I go, let me tell you a story of little Timmy.

Timmy enjoyed programming, especially in Perl. He had his own personal project, on which he spent a lot of his free time. The project grew and grew, and Timmy had implemented self-made tools that would resemble the Elvish method. Little did he know, he had circular imports in his code.

One day Timmy stumbled upon all module while enjoying metacpan. "It's so old and unmaintained, but I'm going to try it anyway" he thought while finding and replacing all his in-house code. When his tests all failed, he searched for two hours trying to figure out what was wrong with the module.

But the module wasn't broken. Funnily enough, it was his code that was to blame and the module just made it visible. Timmy humbly fixed his architecture and had more confidence in his code ever since. You see, the way Elves work may seem sloppy at first glance, but they actually do their work very well. The moral of the story is: don't fix something that isn't broken, especially if actual magic is involved.

Santa's Helper Embrace the Shell

2022-12-13T00:00:00Z

Santa's workshop is very busy and everyone on staff is expected to contribute beyond just their traditional roles. Even Santa's reindeer take on additional tasks throughout the year.

Santa and the elves have been busy this year making vast improvements to their processes, incorporating modern technology such as Perl into their daily workflows.

To improve their real-time efficiency when it comes to irregular activity, debugging, and general proof-of-concept research, everyone has been working to improve their command line fu. Much of what they do involves working with structured data set, such as JSON files.

Typical reindeer...

The reindeer have been helping by extracting important data from the elves' structured notes stored in JSON format. The reindeer need to get the GPS coordinates for the next deliveries in the route.

    {&quot;children&quot;:[{&quot;list&quot;:&quot;naughty&quot;,&quot;name&quot;:&quot;Tom&quot;,&quot;position&quot;:[40.7414728,-74.0055813]},{&quot;location&quot;:[40.7565323,-73.9904037],&quot;name&quot;:&quot;Dick&quot;,&quot;list&quot;:&quot;nice&quot;},{&quot;name&quot;:&quot;Harry&quot;,&quot;list&quot;:&quot;nice&quot;,&quot;location&quot;:[40.7411595,-74.0097167]}]}

The reindeer use this data to determine the next deliveries on Santa's route:

    $ perl -nE &#39;while (s/&quot;name&quot;:&quot;([^&quot;]+)&quot;,&quot;list&quot;:&quot;nice&quot;,&quot;(position|location)&quot;:\[([^,]+),([^\]]+)//) { say &quot;$1\t$3\t$4&quot; }&#39; &lt; route.json
    Harry   40.7411595      -74.0097167

The elves confirmed that Tom, who is naughty, did not get added to Santa's route, but they also noticed that Dick, who is nice, is missing from the list! The reindeers with their poor JSON parser almost caused Dick to get missed! D:

The elves knew this was not a sustainable approach. They decided that they must adopt better tooling to avoid any tragedies with incorrectly skipping a delivery for a child on Christmas day.

The elves find `jp`

The elves discovered a new command line tool for parsing these JSON files and it allows the use of pointers to drill down to the specific data of interest. This new tool is called jp -- for JSON Pointer.

The key features for jp -- made possible by Mojo::JSON from the wonderful Mojolicious framework -- are that the elves can use a simple JSON pointer to get at any specific data in their JSON data structure, but then also use Perl data structures to apply logic for ensuring that they extract exactly the right data and not accidentally route Santa to someone on his naughty list.

The elves first want to look at all of the data in a more natural columnar CSV-type format:

    $ ./jp -r &#39;/children/\d+&#39; /name /list /position /location &lt; advent.json 
    Tom     naughty [40.7414728,-74.0055813]
    Dick    nice    [40.7565323,-73.9904037]
    Harry   nice    [40.7411595,-74.0097167]

Now they could easily pipe that to grep to remove the naughty folks, but we can do better better than that, and avoid skipping any nice children whose name contains the word naughty.

With a little Perl, jp transforms into a powerful command line tool that Santa and the elves can count on:

    $ ./jp -p -r &#39;/children/\d+&#39; -E &#39;$_-&gt;grep(sub{$_-&gt;jp(&quot;/list&quot;) eq &quot;nice&quot;})&#39; /name /position/0 /location/0 /position/1 /location/1 &lt; advent.json 
    /children/1     Dick    40.7565323      -73.9904037
    /children/2     Harry   40.7411595      -74.0097167

Conclusion

jp is a very new tool and the elves are the first in history to discover its existence. They understand that there may be bugs or additional functionality that it lacks, and they are excited to make contributions to improve jp and share those improvements with all the children and everyone else in the world. They have confidence in the tool and their ability to make contributions because it is pretty well documented and comes with a very easy to use test suite that already tests most of jp's functionality.

Download

jp is available today on Github.

Usage

jp has a detailed help listing, optionally including examples:

    $ ./jp -hh
    Usage: ./jp [OPTIONS] [POINTERS]

        Options:
        -A               Dereference JSON arrays into columns
        -C               No collection
        -E eval-string   Evaluate the Perl eval string
                        These functions and variables, in addition to standard Perl functions and variables, are:
            $_            A Mojo::Collection of [JP OBJECTS]
            D             Dump an object to inspect it
            out           Print to stdout and include it in test inspection
            c             Create a new Mojo::Collection object
            f             Create a new Mojo::File object
            l             Create a new Mojo::URL object
            r             Alias to Mojo::Util::dumper
            traverse      Imported from Data::Traverse, if available
        -I exact-match   Compare the results exactly against the supplied text
        -M test-message  Specify a message in the test output
        -R regex         Compare the results against the supplied regex
        -S               Do not sort
        -T eval-string   Compare the results against the supplied Perl eval string
        -U               Remove undef
        -d delimiter     Delimiter to use in columnar output
        -h               Display this help, one more to include examples
        -i               Ignore case in regex JSON pointers
        -k tail-number   Display the bottom n results, n can be negative
        -n head-number   Display the top n results, n can be negative
        -p               Include the pointer in the columnar output
        -r regex-pointer A regex JSON pointer for selecting multiple targets
        -v               Increase verbosity
        
        Jp Objects:
        An object with pointer and value attributes. The primary method to use for this object when iterating a collection
        is the `jp` method which is used to further expand the JSON object by pointer. See the example commented
        &quot;Filtering&quot; for a very practical use case of the Jp object which allows further filtering the results of the regex
        pointer (-r) by iterating the $_ Mojo::Collection of Jp objects with the use of the `grep` method and using a
        JSON Pointer with the `jp` method on each Jp object.

        Pointers:
        Any remaining non-flag arguments are considered JSON pointers and used to narrow the selection from the selected
        JSON string for columnar output.

        Examples:
        (All examples read example.json from stdin, as shown by the first example)

        # Use a JSON pointer to get a value from the JSON data structure
        $ jp /artifactory/0/password &lt; example.json
        s3cr3t

        # Use a JSON pointer to get a value from the JSON data structure, defaults to /
        $ jp
        {&quot;Version&quot;:&quot;1&quot;,&quot;artifactory&quot;:[{...},{...},{...}]}

        # Use a regex in the pointer to reduce the JSON data structure and return each result, one per line
        $ jp -n 1 -r &#39;/artifactory/\d+&#39;
        {...}

        # Use a regex in the pointer to reduce the JSON data structure and include the pointer for all records found
        $ jp -n 1 -p -r &#39;/artifactory/\d+&#39; /user /password
        /artifactory/0  12345 s3cr3t

        # Filtering
        $ jp -Aip -n -1 -d: -E &#39;$_-&gt;grep(sub{$_-&gt;jp(&quot;/isdefault&quot;)})&#39; -r &#39;/Artifactory/\d&#39; /user /password
        /artifactory/1:54321:s3cr3t5

        # Treat the execution as a test
        $ jp -n 1 -E &#39;$_-&gt;tap(sub{out $_-&gt;size})-&gt;tap(sub{out $_-&gt;size})&#39; -r &#39;/artifactory/\d+&#39; /user /password \
            -T &#39;3\n3\n12345\ts3cr3t&#39;
        ok: &#39;Test /user /password&#39; is &#39;3\n3\n12345\ts3cr3t&#39;

        # A syntax error in the -E Perl eval is handled gracefully (final tap method is missing a closing &#39;)&#39;)
        $ jp -v -n 1 -E &#39;$_-&gt;tap(sub{out $_-&gt;size})-&gt;tap(sub{die 123}&#39; -r &#39;/artifactory/\d+&#39; /user /password 
        syntax error in -E eval

        # Don&#39;t sort by pointer, sort arbitrarily as specified in the -E Perl eval
        $ jp -v -S -U -p -r &#39;/markers/\d&#39; -E &#39;$_-&gt;sort(sub{$a-&gt;jp(&quot;/location/0&quot;, &quot;/position/0&quot;) &lt;=&gt; $b-&gt;jp(&quot;/location/0&quot;, &quot;/position/0&quot;)})&#39; /location /position &lt;&lt;EOF
        {&quot;markers&quot;:[{&quot;name&quot;:&quot;Google, 8th Avenue&quot;,&quot;position&quot;:[40.7414728,-74.0055813]},{&quot;name&quot;:&quot;Microsoft, Times Square&quot;,&quot;location&quot;:[40.7565323,-73.9904037]},{&quot;name&quot;:&quot;Tesla, Washington Street&quot;,&quot;location&quot;:[40.7411595,-74.0097167]},{&quot;name&quot;:&quot;Amazon New York&quot;,&quot;location&quot;:[40.7532822,-74.0010696]}]}
        EOF

The Delivery Map

2022-12-12T00:00:00Z

Santa has started to get more absent-minded lately. Year after year he tends to forget a few more things. Just little things like where he left the keys to the sled, or to put his red Santa hat on before he leaves the house.

To give you an idea, in 2021, Santa completely forgot to deliver presents to the Johnson family in Birmingham. He had to come back later to fix it, and nearly got caught by the children!

This kind of mistake takes time and is tiring for Santa. His right-hand elf, worried about Santa's well being, just came up with a solution.

He started to design "TODO-Maps" for his boss.

For this purpose, he decided to use the GraphViz2 Perl module, to build a graph of families to deliver to.

GraphViz is a well known graph visualization software and is easy to use, and the elf was able to come up with a first graph in a matter of minutes:

#!/usr/bin/env perl

use GraphViz2;

my $graph = GraphViz2-&gt;new(graph =&gt; {rankdir =&gt; &quot;LR&quot;});

$graph-&gt;add_edge(from =&gt; &quot;Anderson&quot;, to =&gt; &quot;Johnson&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Johnson&quot;, to =&gt; &quot;Taylor&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Taylor&quot;, to =&gt; &quot;Williams&quot;);

$graph-&gt;run(format =&gt; &quot;svg&quot;, output_file =&gt; &quot;simple.svg&quot;);

And got this nice result:

Make it a Bit Better

It was already a nice help for Santa, but the elf wanted to make it a bit better.

First, to materialize the direction using directed => 1, and second, to change the node shape to house using shape => "house" because after all, these families live in houses!

#!/usr/bin/env perl

use GraphViz2;

my $graph = GraphViz2-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;global =&gt; {name =&gt; &quot;Birmingham&quot;, directed =&gt; 1},
&nbsp;&nbsp;&nbsp;&nbsp;graph  =&gt; {rankdir =&gt; &quot;LR&quot;},
);

$graph-&gt;default_node(
&nbsp;&nbsp;&nbsp;&nbsp;shape  =&gt; &quot;house&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;width  =&gt; &quot;2&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;height =&gt; &quot;2&quot;,
);

$graph-&gt;add_edge(from =&gt; &quot;Anderson&quot;, to =&gt; &quot;Johnson&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Johnson&quot;, to =&gt; &quot;Taylor&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Taylor&quot;, to =&gt; &quot;Williams&quot;);

$graph-&gt;run(format =&gt; &quot;svg&quot;, output_file =&gt; &quot;better.svg&quot;);

And got this result:

The Full Procedure for Santa

Santa was already happy with this map but wanted to go even a bit further.

If the map could also display the chores he would do to get ready for the day, it would be perfect for Santa!

To give you a better idea, this is what Santa's typical day looked like: he would leave his home, head to the shop for some chocolate bars to sustain him on his travels, then walk over to the sled's garage and then finally start his tour (can be a delivery tour if it's Christmas day, or it can be visiting toy crafters to discover new products).

#!/usr/bin/env perl

use GraphViz2;

my $graph = GraphViz2-&gt;new(
&nbsp;&nbsp;&nbsp;&nbsp;global =&gt; {name =&gt; &quot;Birmingham&quot;, directed =&gt; 1},
&nbsp;&nbsp;&nbsp;&nbsp;graph  =&gt; {rankdir =&gt; &quot;LR&quot;},
);

$graph-&gt;default_node(
&nbsp;&nbsp;&nbsp;&nbsp;shape  =&gt; &quot;house&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;width  =&gt; &quot;2&quot;,
&nbsp;&nbsp;&nbsp;&nbsp;height =&gt; &quot;2&quot;,
);

$graph-&gt;push_subgraph(name =&gt; 'cluster_NorthPole', graph =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;label =&gt; 'North Pole',
});
$graph-&gt;add_node(name =&gt; &quot;Santa's house&quot;);
$graph-&gt;add_node(name =&gt; &quot;Supermarket&quot;);
$graph-&gt;add_node(name =&gt; &quot;Sleds' garage&quot;);
$graph-&gt;pop_subgraph;


$graph-&gt;push_subgraph(name =&gt; 'cluster_Birmingham', graph =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;label =&gt; 'Birmingham',
});
$graph-&gt;add_node(name =&gt; &quot;Anderson&quot;);
$graph-&gt;add_node(name =&gt; &quot;Johnson&quot;);
$graph-&gt;add_node(name =&gt; &quot;Taylor&quot;);
$graph-&gt;add_node(name =&gt; &quot;Williams&quot;);
$graph-&gt;pop_subgraph;

$graph-&gt;add_edge(from =&gt; &quot;Santa's house&quot;, to =&gt; &quot;Supermarket&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Supermarket&quot;, to =&gt; &quot;Sleds' garage&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Sleds' garage&quot;, to =&gt; &quot;Anderson&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Anderson&quot;, to =&gt; &quot;Johnson&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Johnson&quot;, to =&gt; &quot;Taylor&quot;);
$graph-&gt;add_edge(from =&gt; &quot;Taylor&quot;, to =&gt; &quot;Williams&quot;);

$graph-&gt;run(format =&gt; &quot;svg&quot;, output_file =&gt; &quot;final.svg&quot;);

It resulted in this graph:

Elves started to print these kinds of maps for every tour Santa has to do, and Christmas was once again a success!

More examples of GraphViz2

Wake up! Time to open presents!

2022-12-11T00:00:00Z

Wake up! Time to open presents!

Clark W. Grisman faced a dilemma, it was the night before Christmas; and he found himself up against a programming deadline. Why a company at the cutting edge of milk-proof cereal coatings required him to write a Perl program, Clark can't remember, but he does know that he's trying to read from a socket that keeps timing out!

Traditional `alarm` Handling

In the past, whenever Clark wanted to call a procedure inside his Perl code that might take too long to return, he always simply copied the example in perldoc -f alarm, which at the time of this Advent season looks like the following:

# ...

eval {
&nbsp;&nbsp;&nbsp;&nbsp;local $SIG{ALRM} = sub { die &quot;alarm\n&quot; }; # NB: \n required
&nbsp;&nbsp;&nbsp;&nbsp;alarm $timeout;
&nbsp;&nbsp;&nbsp;&nbsp;my $nread = sysread $socket, $buffer, $size;
&nbsp;&nbsp;&nbsp;&nbsp;alarm 0;
};
if ($@) {
&nbsp;&nbsp;&nbsp;&nbsp;die unless $@ eq &quot;alarm\n&quot;;   # propagate unexpected errors
    # timed out
}
else {
    # didn't
}

If he didn't need it quite so fancy, he'd just nip it down to:

$SIG{ALRM} = sub { die &quot;alarm\n&quot; }; # NB: \n required
alarm $timeout;
my $nread = sysread $socket, $buffer, $size;
alarm 0;

Clark never liked using alarm in this latter way because it didn't feel very perlish. But he did what he had to, then would just bottle up the guilt. That's what the eggnog is for, he'd tell himself.

`alarm` Handling Comes to Christmastown

Clark is not only a food scientist by day, but he considers himself a Perl artist by night. Realizing this approach seemed a little dated, he recalled seeing a module fly by the CPAN radar that treats alarm's ALRM signal as a catchable exception.

After some searching, he found the module. Try::ALRM. Turns out there was no need to fiddle with the eval stuff directly. Using this handy module, it can be done in the following way using a multi-level block that looks a lot a try/catch construct.

use strict;
use warnings;
use Try::ALRM;
# ...
# thing that can time out
try_once {
&nbsp;&nbsp;&nbsp;&nbsp;my $nread = sysread $socket, $buffer, $size;
}

# code block locally assigned to $SIG{ALRM}
ALRM {
&nbsp;&nbsp;&nbsp;&nbsp;warn qq{Wake up! `sysread` has timed out!};
}

# code run after $SIG{ALRM}
finally {
&nbsp;&nbsp;&nbsp;&nbsp;my ($attempt, $successful) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;if (not $successful) {
        # timed out
    }
&nbsp;&nbsp;&nbsp;&nbsp;else {
        # didn't
    }
}

&nbsp;&nbsp;&nbsp;&nbsp;
# trailing modifier to set timeout (in seconds)
timeout =&gt; $timeout;

Cleaned up, Clark's code came out to be:

try_once {
&nbsp;&nbsp;&nbsp;&nbsp;my $nread = sysread $socket, $buffer, $size;
}
# NB: no ALRM block is a localized no-op $SIG{ALRM}!
finally {
&nbsp;&nbsp;&nbsp;&nbsp;my ($attempt, $successful) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;if (not $successful) {
        # timed out
    }
&nbsp;&nbsp;&nbsp;&nbsp;else {
        # didn't
    }
} timeout =&gt; $timeout;

In the above code, Clark found he didn't even need to define the ALRM handler block, so he didn't include it. Effectively the $SIG{ALRM} handler was a no-op.

`retry`: Never Gonna Give It Up ...

.. not immediately, anyway.

Clark was not satisfied, since he wanted to add some retries; and this is when Try::ALRM really proved its worth. And Clark really needed a win. Chicago PD just SWAT'd the Grisman home because in a misguided attempt at some Christmas cheer, cousin Eddie had, among other things, just emptied the entire contents of his RV's septic tank into the neighborhood's drainage system.

In all its full glory, Clark finished his code in time to enjoy a lot of spiked eggnog before getting some sleep.

use strict;
use warnings;
use Try::ALRM;

# ...

retry {
&nbsp;&nbsp;&nbsp;&nbsp;my $attempt = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $total_tries = tries;
&nbsp;&nbsp;&nbsp;&nbsp;printf qq{Attempt #%d of %d ...\n}, $attempt, $total_tries;
&nbsp;&nbsp;&nbsp;&nbsp;my $nread = sysread $socket, $buffer, $size;
}
ALRM {
&nbsp;&nbsp;&nbsp;&nbsp;my $attempt = shift;
&nbsp;&nbsp;&nbsp;&nbsp;my $total_tries = tries;
&nbsp;&nbsp;&nbsp;&nbsp;my $msg = sprintf qq{FAILED: Attempt #%d of %d ...\n}, $attempt, $total_tries;
&nbsp;&nbsp;&nbsp;&nbsp;warn $msg;
}
finally {
&nbsp;&nbsp;&nbsp;&nbsp;my ($attempt, $successful) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;if (not $successful) {
        # timed out
    }
&nbsp;&nbsp;&nbsp;&nbsp;else {
        # didn't
    }
} timeout =&gt; $timeout, tries =&gt; 5;

It Was Just A Dream

... or was it! Clark frantically searched the house for evidence of the shenanigans of the night before, but realized that it was all a dream. Good thing, because he was really starting to get a hankerin' for the pickle jelly from the Jelly of the Month Club.

Clark did realize that he wished for one part of that dream to be true. Something like this Try::ALRM sure would be a blessing for a lot of things! And what to his wondering eyes did appear, after searching on MetaCPAN, was Try::ALRM and 8 tiny reindeer!

And just at that moment, he's convinced he heard Santa's bells and a jolly old, Ho, Ho, Ho! Merrry Christmas!. He also now sees 8 tiny reindeer everywhere and is really worried that Uncle Eddie slipped more than bottom shelf Kentucky Bourbon in that eggnog.

The Christmas Time Machine

2022-12-10T00:00:00Z

A Terrible Flashback

At the North Pole, the elves are just starting the Christmas 2022 preparations.

As usual they restarted doing line work, building toys, then sorting them per area. Everyone happily singing and working! When suddenly one elf put the first toy in a box marked "Salt Lake City" and was surprised it was not empty...

And he had a terrible flashback, they seemed to have forgotten to deliver the 2021 toys to Salt Lake City!

Go Ask Santa

The elves panicked, so they quickly reached out to Santa for a solution.

He took some time to think about it, then had an idea: Let's use the time machine to go back to 2021 and deliver the gifts!

(If you're wondering: YES, time machines do exist in North Pole! And I bet that elves even already used it in the past for similar mistakes? :P)

So a group of elves decided to use the time machine, fixed the arrival date to 25 December 2021, pushed the "go" button and zooooooooooooop!

Try to Deliver Back in the Past

Upon arriving in 2021, they immediately tried to run Perl software that they took with them.

For the record, in 2021, North Pole was equipped with Ubuntu 20.04 and here is the Perl code they had:

#!/usr/bin/perl

use feature 'try';
no warnings 'experimental::try';

try {
&nbsp;&nbsp;&nbsp;&nbsp;deliver();
} catch($e) {
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Failed to deliver\n&quot;;
}

But it failed with:

    Feature &quot;try&quot; is not supported by Perl 5.30.0 at deliver.pl line 3.
    BEGIN failed--compilation aborted at deliver.pl line 3.

This is because the perl interpreter on which they wanted to run the code is older (5.30 in Ubuntu 20.04) than the one from where they are coming (5.36 in a rolling release distribution).

This is called "forward compatibility".

The Perl Time Machine

One of the elves had heard about the Perl "Time Machine" and was finally able to fix the Perl script thanks to Feature::Compat::Try:

#!/usr/bin/perl

use Feature::Compat::Try;

try {
&nbsp;&nbsp;&nbsp;&nbsp;deliver();
} catch($e) {
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;Failed to deliver\n&quot;;
}

This way, the CPAN module enables the feature try for capable interpreters or implements the feature try for older ones. It allowed the try feature to "travel" in the past with the elves and it also means that, back in 2022, elves would be able to reuse the updated version of the script without any change.

Thanks to this trick, the 2021 Christmas of Salt Lake City was saved! Ouf!

Credits to Paul Evans for Feature::Compat::Try and Perl's Amazing Time Machine

What did Santa forget?

2022-12-09T00:00:00Z

Santa is about ready to start his yearly trip around the world! But does he really have everything?

It would be silly not to deliver a present to someone who has been trying the whole year to be nice. Luckily, to avoid such a blunder, he made a list beforehand:

my %santas_list = (
&nbsp;&nbsp;&nbsp;&nbsp;presents =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Rob',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Lisa',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Brian',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Amy',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Chris',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Larry',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Scott',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Sabina',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Shirley',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Richard',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Amy',
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;other =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'candy canes',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'fireplace break-in tool',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'cookies degustation kit',
&nbsp;&nbsp;&nbsp;&nbsp;],
);

Now all he needs to do is compare it to the list of things he packed. He asked the elves how should he do it, and they suggested giving a try to recently released module Value::Diff:

my %santas_package = (
&nbsp;&nbsp;&nbsp;&nbsp;presents =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Richard',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Rob',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Lisa',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Larry',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Brian',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Scott',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Sabina',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Shirley',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Amy',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'for Chris',
&nbsp;&nbsp;&nbsp;&nbsp;],
&nbsp;&nbsp;&nbsp;&nbsp;other =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'cookies degustation kit',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'candy canes',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'sleigh repair tool',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'fireplace break-in tool',
&nbsp;&nbsp;&nbsp;&nbsp;],
);

use v5.36;
use Value::Diff;
use Data::Dumper;

if (diff(\%santas_list, \%santas_package, \my $missing)) {
&nbsp;&nbsp;&nbsp;&nbsp;say 'looks like you forgot something: ' . Dumper($missing);
}
else {
&nbsp;&nbsp;&nbsp;&nbsp;say 'all looks good...';
}

The diff function used here recursively compares its two first arguments, creating a new data structure which contains the differences. It returns a true value if the arguments are not equal, and the diff is put into $missing.

With this program, Santa got his answer:

    looks like you forgot something: $VAR1 = {
              &#39;presents&#39; =&gt; [
                              &#39;for Amy&#39;
                            ]
            };

Right! There are two Amys on the list, and he only has a present for one. Of course he doesn't need last names, he simply distinguishes them by their first names alone.

Rudolph liked the new module, but since he's a reindeer he has major difficulties typing on the keyboard. He read the documentation thoroughly instead and noticed that the module only finds missing elements, not the excessive ones! So Santa reversed the order of values and tried again:

if (diff(\%santas_package, \%santas_list, \my $excess)) {
&nbsp;&nbsp;&nbsp;&nbsp;say 'looks like you have something extra: ' . Dumper($excess);
}
else {
&nbsp;&nbsp;&nbsp;&nbsp;say 'all looks very good now...';
}

diff function tries to find a Perl data structure which describes the patch for the second value to be equal to the first one. With arguments order reversed in the second call, Santa could see the full picture:

    looks like you forgot something: $VAR1 = {
              &#39;presents&#39; =&gt; [
                              &#39;for Amy&#39;
                            ]
            };
    looks like you have something extra: $VAR1 = {
              &#39;other&#39; =&gt; [
                           &#39;sleigh repair tool&#39;
                         ]
            };

Well of course he doesn't need that, he can use magic instead!

It was getting late and the fireplace started to flicker out. Happy with his program, Santa put his laptop away, stood up and picked up his presents bag. Ho Ho Ho, it's time for the delivery!

A Perlmas Tree

2022-12-08T00:00:00Z

How to Buy a Christmas Tree on Christmas Day :-S

It's just before Christmas Eve. The air smells of cinnamon and gingerbread, the most beautiful Christmas melodies sound everywhere, the Christmas goose has already been ordered, but wait... A very important detail is missing. Rudolph, the Christmas grouch, did not buy a Christmas tree! And so his wife Fjolla, a Christmas elf, asks him to finally get a tree. The same procedure as every year...

But it's just before Christmas Eve... And so the Christmas tree stand of Knecht Ruprecht is sold out.

A Do-it-Yourself Tree with perl

"No problem", Rudolph thinks. Nowadays you can create a Christmas tree with perl. There was a wonderful module by Dave Cross in the Perl Advent Calendar 2018. But to find the perfect fitting tree, you have to hack the code. Therefore a GUI is needed. And why not to try the new module pEFL?

pEFL is an object oriented binding to the Enlightenment Foundation Libraries. And even if it is a very young module, the Elementary part (the widget toolkit) is already very usable. But let's see:

But before take a deep dive into pEFL we make a global hash for the settings to SVG::ChristmasTree with nice defaults on top of our code:

my %settings = (
&nbsp;&nbsp;&nbsp;&nbsp;layers        =&gt; 3,
&nbsp;&nbsp;&nbsp;&nbsp;width         =&gt; 1000,
&nbsp;&nbsp;&nbsp;&nbsp;trunk_length  =&gt; 100,
&nbsp;&nbsp;&nbsp;&nbsp;pot_height    =&gt; 200,
&nbsp;&nbsp;&nbsp;&nbsp;leaf_colour   =&gt; 'rgb(9,186,10)',
&nbsp;&nbsp;&nbsp;&nbsp;bauble_colour =&gt; 'rgb(212,175,55)',
&nbsp;&nbsp;&nbsp;&nbsp;trunk_colour  =&gt; 'rgb(139,69,19)',
&nbsp;&nbsp;&nbsp;&nbsp;pot_colour    =&gt; 'rgb(133,100,69)',
);

All pEFL::Elm applications share the following basic framework, which initializes Elementary, runs the Mainloop and do cleanup when the program exists:

use SVG::ChristmasTree; # for creating the Christmas tree
use pEFL::Elm;
use pEFL::Evas; # for EVAS_CONSTANTS_

pEFL::Elm::init($#ARGV, \@ARGV);
pEFL::Elm::policy_set(ELM_POLICY_QUIT, ELM_POLICY_QUIT_LAST_WINDOW_CLOSED);

### (...GUI CODE COMES HERE...)

pEFL::Elm::run();
pEFL::Elm::shutdown();

Perhaps a little explanation to the policies set with pEFL::Elm::policy_set(): this causes the Mainloop started by pEFL::Elm::run() to quit automatically when the last window of the application is closed.

To create a standard window with a standard background we use the special constructor pEFL::Elm::Win->util_standard_add($name, $title). The autodel setting means that if someone hits the close button, or otherwise uses some normal environment mechanism (keybinding, menu) to close the window, the window object is automatically deleted on the application side. If you don't do this, these mechanisms will not work and the window will stay around if you do not manually add a callback to handle "delete, request" events.

my $win = pEFL::Elm::Win-&gt;util_standard_add(&quot;christmas-tree&quot;, &quot;Christmas Tree&quot;);
$win-&gt;autodel_set(1);
$win-&gt;resize(800,800);

The content will be framed in a pEFL::Elm::Box. This basic container of Elementary is just a linear method of arranging widgets horizontally or vertically. Attention should be paid to the functions $widget->size_hint_weight|align_set(x_expand|align, y_expand_align). With these you control hints for expanding and aligning of the widget packed to the container box. Possible arguments are 0.0 (no expand/align to left/top) to 1.0 (expand/align to the right/bottom). If you want the widget to take up all the space in its parent you can use the special constants EVAS_HINT_EXPAND and EVAS_HINT_FILL together. Because it is much paperwork, we create a function for widgets that expand and fill in all directions:

my $frame = pEFL::Elm::Frame-&gt;add($win);
_expand_widget($frame);
my $container = pEFL::Elm::Box-&gt;add($win);
_expand_widget($container);
$frame-&gt;style_set(&quot;pad_large&quot;);
$frame-&gt;content_set($container);
$frame-&gt;show(); $win-&gt;resize_object_add($frame);

[...]
&nbsp;&nbsp;&nbsp;&nbsp;
sub _expand_widget {
&nbsp;&nbsp;&nbsp;&nbsp;my ($widget) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;$widget-&gt;size_hint_weight_set(EVAS_HINT_EXPAND,EVAS_HINT_EXPAND);
&nbsp;&nbsp;&nbsp;&nbsp;$widget-&gt;size_hint_align_set(EVAS_HINT_FILL,EVAS_HINT_FILL);
}

In the container box we pack three widgets:

1. An pEFL::Elm::Image widget that serves as a viewer

my $viewer = pEFL::Elm::Image-&gt;add($container);
_expand_widget($viewer);
$viewer-&gt;show(); $container-&gt;pack_end($viewer);

2. An pEFL::Elm::Table widget where the controls of the several settings are aligned

A table is like a box with 2 dimensions. An item of the table can span multiple columns and rows, and even overlap with other items.

my $table = pEFL::Elm::Table-&gt;add($container);
$table-&gt;padding_set(10,10);
$table-&gt;size_hint_weight_set(EVAS_HINT_EXPAND,0);   # Expand and fill only to the
$table-&gt;size_hint_align_set(EVAS_HINT_FILL,0);      # X-Direction
$table-&gt;show(); $container-&gt;pack_end($table);

For changing the settings of the tree we add several sliders.

_add_slider_setting($table, 4, {label =&gt; &quot;Width of the tree&quot;, min =&gt; 700, max =&gt; 3000, key =&gt; &quot;width&quot;});
_add_slider_setting($table, 5, {label =&gt; &quot;Layers&quot;, min =&gt; 2, max =&gt; 8, key =&gt; &quot;layers&quot;});
_add_slider_setting($table, 6, {label =&gt; &quot;Trunk length&quot;, min =&gt; 50, max =&gt; 300, key =&gt; &quot;trunk_length&quot;});
_add_slider_setting($table, 7, {label =&gt; &quot;Pot height&quot;, min =&gt; 100, max =&gt; 400, key =&gt; &quot;pot_height&quot;});

For this we use the custom function _add_slider_settings($table,$row,$option_hash):

sub _add_slider_setting {
&nbsp;&nbsp;&nbsp;&nbsp;my ($table,$row,$opts) = @_;

&nbsp;&nbsp;&nbsp;&nbsp;my $label = pEFL::Elm::Label-&gt;add($table);
&nbsp;&nbsp;&nbsp;&nbsp;$label-&gt;text_set($opts-&gt;{label});
&nbsp;&nbsp;&nbsp;&nbsp;$label-&gt;show(); $table-&gt;pack($label,0,$row,1,1);

&nbsp;&nbsp;&nbsp;&nbsp;my $spinner = pEFL::Elm::Slider-&gt;add($table);
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;size_hint_align_set(EVAS_HINT_FILL,0.5);
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;size_hint_weight_set(EVAS_HINT_EXPAND,0.0);
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;min_max_set($opts-&gt;{min},$opts-&gt;{max});
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;step_set(1);
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;indicator_format_set(&quot;%1.0f&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;value_set($settings{$opts-&gt;{key}});
&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;show(); $table-&gt;pack($spinner,1,$row,2,1);

&nbsp;&nbsp;&nbsp;&nbsp;$spinner-&gt;smart_callback_add(&quot;delay,changed&quot; =&gt; sub {$settings{$opts-&gt;{key}} = int($_[1]-&gt;value_get());}, undef);
}

Most of the code should be self-explanatory. Therefore only two little explanations:

With $spinner->indicator_format_set("%1.0f"); the popup for the actual value shows only integers.

Very important is the $spinner->smart_callback_add("eventName",\&eventSub,$data). With this you can register an event handler for smart callbacks, the most often used event types in EFL. The callback function takes as parameters the additional $data defined in the $widget->smart_callback_add(), the object to which the event happened, and the event info data, which depends on the object type and the event at play. So the signature is

sub smart_event_cb {
&nbsp;&nbsp;&nbsp;&nbsp;my ($data, $obj, $evInfo) = @_;
}

In the example code we use an anonymous subroutine as event handler that sets the key in the setting hash with the actual value of the spinner object.

3. Last we add the button to create the Christmas tree to the container-box

and show the window (don't forget this!!)

my $btn = pEFL::Elm::Button-&gt;add($container);
$btn-&gt;text_set(&quot;Create a new Christmas Tree&quot;);
$btn-&gt;smart_callback_add(&quot;clicked&quot;,\&amp;create_christmas_tree,$viewer);
$btn-&gt;show(); $container-&gt;pack_end($btn);

$win-&gt;show()

Again we register a callback to the following event handler that creates the SVG file and let the viewer show the created tree. A little hack is needed with $viewer->file_set(undef,""). Otherwise the viewer doesn't know that the file has changed:

sub create_christmas_tree {
&nbsp;&nbsp;&nbsp;&nbsp;my ($viewer,$obj,$evinfo) = @_;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;my $tree = SVG::ChristmasTree-&gt;new(\%settings);

&nbsp;&nbsp;&nbsp;&nbsp;open my $fh, &quot;&gt;&quot;, &quot;tree.svg&quot; or die &quot;Could not write to ./tree.svg: $!\n&quot;;
&nbsp;&nbsp;&nbsp;&nbsp;print $fh $tree-&gt;as_xml;
&nbsp;&nbsp;&nbsp;&nbsp;close $fh;

&nbsp;&nbsp;&nbsp;&nbsp;$viewer-&gt;file_set(undef,&quot;&quot;);
&nbsp;&nbsp;&nbsp;&nbsp;$viewer-&gt;file_set(&quot;./tree.svg&quot;,&quot;&quot;);
}

Conclusion

I hope you enjoyed this little introduction to pEFL. Because the Perl advent articles should be light and trivial, the explained version only gives you control over the numeric settings of SVG::ChristmasTree. But at my Perl Advent 2022 github repository you find also an advanced version where you can also alter the colors of the tree, baubles and pot. The additions adjust the colorselector examples under examples/colorselector.pl in the pEFL distribution and hopefully are understandable.

If you want to get deep into programming with pEFL, see the explanations at pEFL. As the API of pEFL is (apart from its object-oriented interface) deliberately kept close to the Elementary C API, the documentations at the Enlightenment docs should help you, too. The Perl method names usually remove the prefix at the beginning of the C functions. Therefore applying the C documentation should be no problem.

And of course, you can get help at Github. And perhaps you want to contribute and to make the pEFL bindings better? In any case there is much to do :-)

Merry Christmas 🎄 🎄 🎄 🎄 🎄 🎄

The Sleigh odometer

2022-12-07T00:00:00Z

Sleigh Odometer

Customize the Sleigh

It's already December and elves are working hard to produce all of the toys for Christmas.

On the other side, Santa is preparing his sleigh, cleaning or customizing.

This year, in addition to a temperature sensor, Santa asked to install an odometer to his sleigh so that he can count each delivery. For the record, the distance unit is neither kilometers nor miles nor inches but "elf little toe"... but it does not change what follows :)

In order to implement the counter of the odometer, an elf came up with this code:

#!/usr/bin/env perl
use 5.010;

sub count() {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $distance = 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return ++$distance;
}

count(); count(); count(); count();
say count();

But sadly it does not work as expected because the distance is reset at each count() call :/

Asking Experienced Elves

After asking some more experienced elves, the elf decided to implement a persistent variable via a "lexical trick":

#!/usr/bin/env perl
use 5.010;

{
&nbsp;&nbsp;&nbsp;&nbsp;my $distance = 0;
&nbsp;&nbsp;&nbsp;&nbsp;sub count {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return ++$distance;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

count(); count(); count(); count();
say count();

And it worked!

Some other experienced elf proposed to use a "closure" that he perceived as "more elegant":

#!/usr/bin/env perl
use 5.010;

sub make_counter() {
&nbsp;&nbsp;&nbsp;&nbsp;my $distance = 0;
&nbsp;&nbsp;&nbsp;&nbsp;return sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return ++$distance;
&nbsp;&nbsp;&nbsp;&nbsp;}
}

my $counter = make_counter();

$counter-&gt;(); $counter-&gt;(); $counter-&gt;(); $counter-&gt;();
say $counter-&gt;();

Final Word from Santa

These 2 previous pieces of code work well, but there is definitely a simpler way!

As usual, the final word came from Santa who decided to use state:

#!/usr/bin/env perl
use 5.010;

sub count() {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;state $distance = 0;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return ++$distance;
}

count(); count(); count(); count();

say count();

With this new "option", Santa felt upgraded and was able to know when to take a break or when to feed the reindeers!

And most important of all, it helped to arrive on time for the dinner prepared by Mrs Claus!

References

See Perl Maven "static and state variables in perl"

St. Nick's Reindeers Need H2O!

2022-12-06T00:00:00Z

Reindeer are generally hardy creatures, but the ones Santa chooses must also be of the heartiest character. Though they spend only 24 hours of the whole year in flight, it is during this marathon that they must cheerfully give all they have. And Santa makes sure that they have all the hydration and other essentials their bodies need. Recently St. Nick's head reindeer trainer has purchased a new set of Camelbak personal H2O delivery systems that is highly tuned for use in flight, which have 3 reservoirs rather than the standard 1, so that they don't get too parched.

Being one who obviously dabbles in Perl in the off season, Santa was reminded of a module he recently added to the "Good List". It is called Util::H2O and it a relatively new addition to the growing list of Perl modules on CPAN that turn HASH references to blessed references with automatically generated accessor methods.

Santa has, in fact, been sorely tempted to move this module to the Very Good Module List since he's found it so handy with all of the Perl programming he does that involves HASH references. He finds it particularly useful when wrangling results from DBI's selectall_hashref method, the results produced from his web scraping activities using Web::Scraper, or the HASH reference he gets after decode_json'ing a block of JSON data from the different web API he uses to track the online activities everyone on his various watch lists based on a new goodness metric Mrs. Claus has been affectionately calling it, Santa's Credit Score.

Just recently, Santa created this script that uses Util::H2O to add accessors to data in flight in order to make it easier to manage the response HASH reference returned by HTTP::Tiny.

use strict;
use warnings;
use JSON       qw//;
use HTTP::Tiny qw//;
use Util::H2O; # only exports 'h2o'

Santa can slip h2o inline to his GET request with more ease than he's able to slip into a chimney! Can you spot the addition of h2o?

# give's Santa &quot;$response-&gt;content&quot;, &quot;$response-&gt;status&quot;, &quot;$response-&gt;success&quot;, etc
# from HTTP::Tiny's response object (pure HASH)

my $http = HTTP::Tiny-&gt;new;
my $response = h2o $http-&gt;get(q{https://jsonplaceholder.typicode.com/users});

Checking for success is clean and easy,

# check for unsuccessful web request

if (not $response-&gt;success) {
&nbsp;&nbsp;&nbsp;&nbsp;print STDERR qq{Can't get list of online persons to watch!\n};
&nbsp;&nbsp;&nbsp;&nbsp;printf STDERR qq{Web request responded with with HTTP status: %d\n}, $response-&gt;status;
&nbsp;&nbsp;&nbsp;&nbsp;exit 1;
}

The JSON content in the HTTP call is also easily accessed so that it may be turned into a Perl data structure via JSON::decode_json.

# decode JSON from response content
my $json_array_ref = JSON::decode_json($response-&gt;content); # $json is an ARRAY reference

In this case and after referencing the API response specification, Santa can see that he gets an ARRAY of HASH references:

  # [
  #  {
  #    &quot;id&quot;: 1,
  #    &quot;name&quot;: &quot;Leanne Graham&quot;,
  #    &quot;username&quot;: &quot;Bret&quot;,
  #    &quot;email&quot;: &quot;Sincere@april.biz&quot;,
  #    &quot;address&quot;: {
  #      &quot;street&quot;: &quot;Kulas Light&quot;,
  #      &quot;suite&quot;: &quot;Apt. 556&quot;,
  #      &quot;city&quot;: &quot;Gwenborough&quot;,
  #      &quot;zipcode&quot;: &quot;92998-3874&quot;,
  #      &quot;geo&quot;: {
  #        &quot;lat&quot;: &quot;-37.3159&quot;,
  #        &quot;lng&quot;: &quot;81.1496&quot;
  #      }
  #    }
  #  },
  # ...
  # ]

And even though h2o only works on HASH references, this provides yet another opportunity for Santa to use h2o on each item in the ARRAY, which makes dealing with each person's record much more jolly:

print qq{lat, lng, name, username\n};

foreach my $person (@$json_array_ref) {

    # -recurse creates deep accessors, e.g.,
&nbsp;&nbsp;&nbsp;&nbsp;#  $person-&gt;address-&gt;geo-&gt;lat;

&nbsp;&nbsp;&nbsp;&nbsp;h2o -recurse, $person;

&nbsp;&nbsp;&nbsp;&nbsp;printf qq{%5.4f, %5.4f, %s, %s\n},
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$person-&gt;address-&gt;geo-&gt;lat,   # deep chain of accessors from '-recurse'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$person-&gt;address-&gt;geo-&gt;lng,   # deep chain of accessors from '-recurse'
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$person-&gt;name,
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$person-&gt;username;
}

Santa thinks this is such a nice interface for Perl HASH references, he might even be able to convince the Easter bunny to finally get off His cotton tail and finally create that centralized database they and the Tooth Fairy can use all year long ... yanno, for distributing good stuff only.

Conclusion

With St. Nick's list now complete with online usage profiles for all people, he now sets his mind on more jolly thoughts; not sugar plums and candy canes, but all the applications for which he may use Util::H2O to make working with HASH references in flight more pleasant:

DBI
HTTP::Tiny
Web::Scraper
Config::Tiny
JSON
Getopt::Long (with Util::H2O::More's opt2h2o)

He may even check out using the bless replacement, baptise, which is contained in Util::H2O::More and is like bless, but gives you the ability to create accessors too!

Don't get on Santa's Naughty List by using cumbersome and chunky Perl OOP frameworks when all you really need is a little H2O. Go check out Util::H2O and see if it's right for your next Perl project or can be used to tidy up existing code!

Merry Christmas to All, and to All a Good Night!

Catching dreams

2022-12-05T00:00:00Z

Listening to dreams

During the year, some kids are writing "letters to Santa" or just sharing loudly what they want to "order" for Christmas, but it's not always the case... Sometimes kids are only dreaming what they want.

Normally, dreaming is not the most effective way to "order" a present for Christmas, but Santa has thought of everything. There is a special room in North Pole complex for this purpose. It's an all white, circular room with chairs arranged in the middle. Elves arrive at the room when it is nighttime in their assigned timezone.

They bring a pen and a notebook, and they listen to children's dreams and take notes.

Gathering notebooks

Elves capture notes on children's dreams all year long and, hence, approaching Christmas there are plenty of notebooks to put together and add to other wishes.

One of the elves had the idea to use MongoDB to store data.

Santa complained MongoDB was not Perl friendly (e.g. struggles with drivers...) and has a license that can be considered by some as "controversial"... But the elves are not disciplined and decided to go with it anyway.

1. First they installed MongoDB:

    $ sudo apt-get install mongodb

2. Then they started a shell:

    $ mongo
    MongoDB shell version v3.6.8
    connecting to: mongodb://127.0.0.1:27017
    MongoDB server version: 5.0.9
    &gt;

3. The elves created a new database:

    &gt; use christmas2022
    switched to db christmas2022

Import dreams

Despite being undisciplined, the elves followed a convention in their notes and all of their notebooks are all well-formatted as CSV.

At the end of the night, a notebook looks like this:

    what,who,where
    bicycle,Tom,Atlanta
    Barbie,Lisa,Berlin
    Transformer,Billy,Houston
    ball,Ismail,Atlanta

It's easy to import these notes into MongoDB:

    $ mongoimport -d christmas2022 -c gifts --type csv --file gifts.csv --headerline
    2022-08-04T09:57:42.400+0200    connected to: mongodb://localhost/
    2022-08-04T09:57:42.408+0200    4 document(s) imported successfully. 0 document(s) failed to import.

And you can quickly verify that it is imported:

    &gt; db.gifts.find()
    { &quot;_id&quot; : ObjectId(&quot;62eb96777d9a1bc25a68b25c&quot;), &quot;what&quot; : &quot;Transformer&quot;, &quot;who&quot; : &quot;Billy&quot;, &quot;where&quot; : &quot;Houston&quot; }
    { &quot;_id&quot; : ObjectId(&quot;62eb96777d9a1bc25a68b25d&quot;), &quot;what&quot; : &quot;bicycle&quot;, &quot;who&quot; : &quot;Tom&quot;, &quot;where&quot; : &quot;Atlanta&quot; }
    { &quot;_id&quot; : ObjectId(&quot;62eb96777d9a1bc25a68b25e&quot;), &quot;what&quot; : &quot;ball&quot;, &quot;who&quot; : &quot;Ismail&quot;, &quot;where&quot; : &quot;Atlanta&quot; }
    { &quot;_id&quot; : ObjectId(&quot;62eb96777d9a1bc25a68b25f&quot;), &quot;what&quot; : &quot;Barbie&quot;, &quot;who&quot; : &quot;Lisa&quot;, &quot;where&quot; : &quot;Berlin&quot; }

Using Perl to access dreams

To integrate this database in the North Pole code, the elves need to interact with it in Perl.

Let's install Mango:

    $ sudo cpanm Mango

Then they can access records with Perl methods:

use Mango ();
use feature qw( state );
&nbsp;
sub mango { state $m = Mango-&gt;new('mongodb://localhost:27017') }

my $docs = mango-&gt;db('christmas2022')-&gt;collection('gifts')-&gt;find();

while (my $doc = $docs-&gt;next) {
&nbsp;&nbsp;&nbsp;&nbsp;print &quot;$doc-&gt;{what} for $doc-&gt;{who} in $doc-&gt;{where}\n&quot;;
}

And it produces this kind of output:

    Transformer for Billy in Houston
    bicycle for Tom in Atlanta
    ball for Ismail in Atlanta
    Barbie for Lisa in Berlin

Give me dreams from Atlanta

When it comes time for making deliveries, Santa is interested in having records from the same area to optimize the logistics of his delivery schedule.

With Mango, it's just a matter of adding a "clause" in the `find()` function:

my $docs = mango-&gt;db('christmas2022')-&gt;collection('gifts')-&gt;find({where =&gt; 'Atlanta'});

Conclusion

With the elves' copious year-round notetaking of children's dreams, Santa can count on the elves not to miss any of the children's wishes for Christmas.

Aided by Mango, Santa and the elves can handle the list easily and at end of December deliver something you only ever dreamed of!

northpole.cgi

2022-12-04T00:00:00Z

As is the case in most public sector institutions, a lot of the tools at the North Pole are out of date. The elves often need to work with terrible spaghetti CGI scripts that are still around from the olden days. Quite a few of their internal tools with web interfaces are still implemented using CGI, and despite the ongoing effort by the elves to port them over to Plack, several of the more critical tools are still mostly untouched. After all, why change a running system?

Of course the original development infrastructure has long since disappeared. Just a few Christmases ago they "lost" the last remaining CGI development box when a very desperate sysadmin somewhere in a small town in Texas in the United States wanted nothing more than a working Debian Woody machine. (Some of the elves still wonder how Santa got that bulky server into the guy's stocking).

The elves had to come up with an alternative.

Enter App::CGIThis

One of the tools the elves have been using for a long time when making websites is http_this, the script that ships with App::HTTPThis. It lets them access a folder full of files from their browser by creating a simple web server via Plack::Runner.

One clever elf recently discovered that you could also do this with CGI scripts. After a bit of tinkering they are now using App::CGIThis and the cgi_this command whenever they have to debug one of these old CGI scripts.

    $ cgi_this
    Exporting &#39;.&#39;, available at:
    http://127.0.0.1:3000/

    Found the following scripts:
        http://127.0.0.1:3000/hello.cgi

If run with no arguments, it simply turns the whole current directory into a CGI script serving web server that listens on port 3000. The elves like this to test quick fixes to the configuration-heavy scripts that they haven't managed to migrate yet.

The two remaining original CGI elves think this is not necessary, because they could of course make these changes in production, claiming the younger elf generation is too scared to get things done, but luckily the head elf is heaving none of that. Instead, these two now use cgi_this with the --cgi-bin flag, which makes the URLs look more like what they are used to.

    $ cgi_this --cgi-bin
    Exporting &#39;.&#39;, available at:
    http://127.0.0.1:3000/

    Found the following scripts:
        http://127.0.0.1:3000/cgi-bin/hello.cgi

So, despite the selfless act of giving their last old machine to a fellow techie in need, they can still safely test their work whenever they have to debug one of the old scripts.

Santa is on GitHub

2022-12-03T00:00:00Z

Last year, Santa lost his mind with missing gifts, hence he gathered a council with the elves and they decided to make the process more "rigorous" in 2023. This year, it has been decided to use a GitHub repository to organize and track the preparation of gifts for Christmas.

Santa has created a repository called "gifts" in his account "santa".

Each time an elf has finished preparing a toy, he commits a quick note and a helpful message, e.g. "A cowboy for James".

So far, "What is the relation with Perl?" you might ask. It's just a great opportunity to discover and use Pithub :)

Look at last prepared toys (commits)

Every once in a while, Santa -- or the elves themselves -- want to check produced items, so they use Pithub for that:

use Pithub::Repos ();

my $repos  = Pithub::Repos-&gt;new;
my $result = $repos-&gt;commits-&gt;list( user =&gt; 'santa', 
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;repo =&gt; 'gifts' );

while ( my $row = $result-&gt;next ) {
&nbsp;&nbsp;&nbsp;&nbsp;print $row-&gt;{commit}-&gt;{message} . &quot;\n&quot;;
}

It produces this kind of output:

    A bicycle for Tom
    A Barbie for Lisa
    A Transformer for Billy

Gifts should remain a surprise!

But wait, a public GitHub repository means any little young programmer frequenting GitHub will know in advance his Christmas present?! This is not good at all, so Santa decided to change visibility of the repository to "private".

It seemed at first to work well but, sadly, even though Santa and the elves could still access the repo via the GitHub UI, they were no longer able to list the commits via Pithub.

They started to debug by adding some error handling:

unless ( $result-&gt;success ) {
&nbsp;&nbsp;&nbsp;&nbsp;printf &quot;Error: %s\n&quot;, $result-&gt;response-&gt;status_line;
&nbsp;&nbsp;&nbsp;&nbsp;exit 1;
}

This confirmed that the repository is "not visible" with Error: 404 Not Found

Fortunately, there is a solution to this: use a "token" to authenticate the access!

The elves asked Santa to create one in the GitHub UI from settings/tokens:

The elves provided the generated token to the Pithub constructor and regained access to the private repository:

use Pithub::Repos ();

my $repos  = Pithub::Repos-&gt;new(token =&gt; 'ghp_pwBR12');
my $result = $repos-&gt;commits-&gt;list(user =&gt; 'santa', 
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;repo =&gt; 'gifts');

unless ( $result-&gt;success ) {
&nbsp;&nbsp;&nbsp;&nbsp;printf &quot;Error: %s\n&quot;, $result-&gt;response-&gt;status_line;
&nbsp;&nbsp;&nbsp;&nbsp;exit 1;
}

while ( my $row = $result-&gt;next ) {
&nbsp;&nbsp;&nbsp;&nbsp;print $row-&gt;{commit}-&gt;{message} . &quot;\n&quot;;
}

Using a token also allows you to increase your GitHub API rate limit.

Sending gifts

To alert when a toy is about to be delivered, the elves are opening Pull Requests, and they once again use Pithub for this.

Each elf is doing one Pull Request per family, and after Santa actually delivers the toys he merges the Pull Requests. (Don't ask me to elaborate a full branching model).

It's a little bit of work, but once again very easy and straightforward:

use Pithub::PullRequests ();

my $pull  = Pithub::PullRequests-&gt;new(token =&gt; 'ghp_pwBR12');

print &quot;Create PR from [family-anderson] to [main]\n&quot;;
$result = $pull-&gt;create(
&nbsp;&nbsp;&nbsp;&nbsp;user  =&gt; 'santa',
&nbsp;&nbsp;&nbsp;&nbsp;repo  =&gt; 'gifts',
&nbsp;&nbsp;&nbsp;&nbsp;data   =&gt; {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;base  =&gt; 'main',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;body  =&gt; 'Delivery to family Anderson',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;head  =&gt; 'family-anderson',
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;title =&gt; 'Family Anderson',
&nbsp;&nbsp;&nbsp;&nbsp;}
);

unless ( $result-&gt;success ) {
&nbsp;&nbsp;&nbsp;&nbsp;printf &quot;Error: %s\n&quot;, $result-&gt;response-&gt;status_line;
&nbsp;&nbsp;&nbsp;&nbsp;exit 1;
}

Conclusion

Thanks to Pithub, the elves were able to easily interact with the GitHub API for both reading and writing.

If Christmas is once again a success this year, some of the credit should go to Pithub!

MooseX::Getopt saves Christmas

2022-12-02T00:00:00Z

"It's done, sir." An elf that had the fuzzy, out of focus look of a developer who'd been awake since the beginning of Advent stuck their head round Santa's door. "New, uh, present delivery planning script, like you asked. No more gender-specific toys, and naughty or nice checks are now optional. And it feeds the new delivery plotting script or your SledNav."

"Hrm. OK." Santa nodded, distractedly. "I'll take a look later."

They blinked. "OK. I'll just... uh... go crash for a bit." Looking like they would do so before they made it much further down the corridor, they stumbled out.

Some while later:

Santa brought up a shell prompt. "Hrmmm. Let's see. Ahah."

    $ delivery_plan
    Usage: delivery_plan [options]

Saint Nick harumphed.

    $ delivery_plan --help
    Usage: delivery_plan [options]

"ERNEST!"

Santa's right-hand elf hurried in. "Yes boss?"

"What in the name of Christmas am I supposed to do to get this to run?"

Ernest peered over Santa's shoulder. "Is that the new delivery script? I better take a look - the dev is snoring fit to be heard in Bethlehem, and I don't think they'll wake up before New Year."

Command line options

Ernest sighed, back at his desk. "OK. No marks for hand-rolling the option parsing..." He copied the main script to NorthPole/DeliveryPlan.pm and edited it, removing the crufty command line parsing code and wrapping the remainder of the body of the script in a method.

package NorthPole::DeliveryPlan;
use v5.36;
use Moose;
with 'MooseX::Getopt';

use feature 'signatures';

sub run ($self) {
    # body of script
}

Santa's right-hand elf's right-hand elf peered curiously over Ernest's shoulder. "Whatcha doing?" she asked.

He sighed. "Fixing the new delivery planning script. Someone committed it without even basic usage docs." Ernest opened a new delivery_plan file for the script itself. "Here. Watch.".

use NorthPole::DeliveryPlan;
my $app = NorthPole::DeliveryPlan-&gt;new_with_options();
$app-&gt;run;

"Hang on." She frowned. "Didn't legal just say yesterday we couldn't use Moose?"

Ernest permitted himself a snort which precisely defined his opinion of legal. "Internal software. None of their business."

"Ok, so - new_with_options essentially uses the attribute definitions on the class to define how it parses any command line options, and then passes them as constructor arguments to the object. So..." he went back to NorthPole::DeliveryPlan "We can add a --nice_check switch by just adding a nice_check attribute..."

has 'nice_check' =&gt; (is =&gt; 'rw', isa =&gt; 'Bool');

She chuckled. "Oh! Neat. The command line switch value ends up on the attribute, so you can just check it with $self->nice_check, right? Let me guess - if you set required => 1, it's a mandatory parameter?"

Ernest nodded, "In one. And it also gives you --no-nice_check for free because it's a Bool."

She nodded, then went on. "And... Wow, so, ok... waitaminnit... if it's a Str or a Num, then, the parameter takes a value?" Ernest hid a smile and carried on typing.

has 'country' =&gt; (is =&gt; 'rw', isa =&gt; 'Str', required =&gt; 1);

"Like that, you mean." He grinned. "Exactly so - that handles --country=GB, for example."

She frowned. "Didn't Santa say he wanted to process multiple countries at once?"

Ernest 'mmhm'-ed. "He did, yes. We can do that easily enough." He edited the definition.

has 'country' =&gt; (is =&gt; 'rw', isa =&gt; 'ArrayRef', required =&gt; 1);

"There. Just pass --country multiple times and you can pick the results out of $self->country."

She clapped, delightedly. "Neato. Ok, but what about documentation?"

Ernest chuckled. "Ok, fair. That was the original point of this. So. We have Getopt::Long::Descriptive installed anyway, since some people do actually remember to use it, so all you have to do is add documentation to the attribute definition and the role will respond to --help, --usage or -? with the docs for all the options."

has 'output' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is            =&gt; 'rw',
&nbsp;&nbsp;&nbsp;&nbsp;isa           =&gt; 'Str',
&nbsp;&nbsp;&nbsp;&nbsp;required      =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;documentation =&gt; &quot;output format - one of 'plot' or 'slednav'&quot;,
);

She frowned. "Can't you make it just accept those two values?"

"Oh... yeah. Sure. We'll just create an enum for them, and because that's just a subtype of Str it falls out in the wash."

use Moose::Util::TypeConstraints;

enum 'OutputFormat', [ qw/ plot slednav / ];
has 'output' =&gt; (
&nbsp;&nbsp;&nbsp;&nbsp;is            =&gt; 'rw',
&nbsp;&nbsp;&nbsp;&nbsp;isa           =&gt; 'OutputFormat',
&nbsp;&nbsp;&nbsp;&nbsp;required      =&gt; 1,
&nbsp;&nbsp;&nbsp;&nbsp;documentation =&gt; &quot;output format - one of 'plot' or 'slednav'&quot;,
);

He added the rest of the documentation, and another option. "And then... here we go."

    $ delivery_plan
    Mandatory parameter &#39;country&#39; missing in call to &quot;eval&quot;

    usage: delivery_plan [-?h] [long options...]
        -h -? --usage --help  Prints this usage information.
        --[no-]nice_check     DEPRECATED: only deliver to those who have been
                              nice.
        --[no-]gender         DEPRECATED: gender-specific presents
        --country STR...      which countries to deliver to
        --output STR          output format - one of &#39;plot&#39; or &#39;slednav&#39;

"If its a more complex type and the behaviour on the parent type isn't enough, there's a helper function to update the type map, add_option_type_to_map, but you can read up on that in the module docs yourself." Ernest grinned at her. "And to be fair, some of the type-checking errors are a bit Moose-y, but..."

She laughed. "I know, I know. 'Patches welcome.'"

He laughed "Exactly. Now scoot, while I test this and push it."

Epilogue

Ernest fired off an email.

    Hi,

    When you wake up, please check the commit log for the delivery plan script,
    and learn from it. The Big Red Boss doesn&#39;t have time to read source code
    to figure out what things we give him are meant to do.

    Also, how on Earth did you manage to come up with an O(N) solution
    to the travelling salesman problem? Magic?

    E.

Silent Mite

2022-12-01T00:00:00Z

Ernest the Elf sat outside Santa's office. It was August, a time of year the boss was usually less stressed. A good thing, as he had some bad news to deliver.

The door opened and an elf that Ernest vaguely recognized from the staff lunch room emerged and hastened down the hall. A booming voice came from inside the office. "Next!"

Ernest hurried in and the old man gestured for him to take a seat. This was his first time meeting Santa in person since he'd started with the company. "Sir, I'm afraid I have some bad news about the ninja robot aliens."

"Please," Santa said, "no need to call me 'Sir'. Everybody just calls me 'Santa'. So what's going on with the ninja robot aliens? I know they're going to be popular. It's summer and I'm already getting letters. You're heading up the software development for them, right?"

Ernest nodded. "Yes, we've been writing it using Moose." He paused. The silence was interrupted by Rudolf's honks outside in the field.

"Appropriate!" Santa laughed, his belly shaking like a bowlful of jelly.

"Indeed," said Ernest. "But legal have just told us we can't use Moose. No third party code can be bundled unless it has a warranty."

"Legal," grumbled the old man. "You know last year they tried telling me I can't drink alcohol at every single house I stop at while operating a sophisticated flying sleigh? Bunch of killjoys. Are you using the metaobject protocol?" Santa asked, displaying a knowledge of Perl programming which surprised Ernest.

"No," said Ernest. "But switching to Moo isn't an option anyway, because that doesn't have a warranty either. We can only use core Perl because our embedded hardware support contract covers that."

Santa frowned. "I guess that would need a big rewrite. Is there enough time before December?"

Ernest shook his head. "Not if we want to leave enough time for code reviews, acceptance testing, quality assurance..." His voice trailed off.

"Let's take a look at the code," Santa suggested, pulling up a fresh checkout of the repository and turning his screen around so Ernest could go through it with him. He opened up a random class.

use v5.24;
use experimental 'signatures';

package Robot::Alien::Ninja::Face;

use Moose;
use Time::HiRes 'sleep';

my $eye_class = 'Robot::Alien::Ninja::Face';

has eyes =&gt; (
&nbsp;&nbsp;&nbsp;is =&gt; 'ro',
&nbsp;&nbsp;&nbsp;isa =&gt; &quot;ArrayRef[$eye_class]&quot;,
&nbsp;&nbsp;&nbsp;builder =&gt; '_build_eyes',
);

...;

sub _build_eyes ( $self ) {
&nbsp;&nbsp;&nbsp;return [ $eye_class-&gt;new, $eye_class-&gt;new ];
}

sub blink ( $self, %arg ) {
&nbsp;&nbsp;&nbsp;$_-&gt;close for $self-&gt;eyes-&gt;@*;
&nbsp;&nbsp;&nbsp;sleep( $arg{time} // 0.2 );
&nbsp;&nbsp;&nbsp;$_-&gt;open for $self-&gt;eyes-&gt;@*;
}

sub wink ( $self, %arg ) {
&nbsp;&nbsp;&nbsp;my $eye = $self-&gt;eyes-&gt;[ $arg{eye} // 0 ];

&nbsp;&nbsp;&nbsp;$eye-&gt;close;
&nbsp;&nbsp;&nbsp;sleep( $arg{time} // 0.4 );
&nbsp;&nbsp;&nbsp;$eye-&gt;open;
}

...;

__PACKAGE__-&gt;meta-&gt;make_immutable;

Santa nodded while reading it. "Pretty clean code." His fingers flew across the keyboard, tapping in a few commands.

   cd ~/src/Robot-Alien-Ninja
   cpanm Mite
   mite init Robot::Alien::Ninja
   mite compile

He then edited Face.pm replacing use Moose with use Robot::Alien::Ninja::Mite -all, and replaced __PACKAGE__->meta->make_immutable with true.

He ran mite compile again and then started the test suite. It all passed.

"So will legal let us distribute Mite?" Ernest asked, confused.

"That's the beauty of it!" Santa smiled. "Your code doesn't depend on Mite. It depends on Robot::Alien::Ninja::Mite, which is under 300 lines long and you can audit in a few hours. Mite itself is a tool that lives on your development machine, but doesn't need to be installed on the ninja robot pirates."

"Aliens," said Ernest.

"Of course, aliens," said Santa, making a mental note for what was sure to be next year's hit toy. "Think about it this way. You use, what, emacs to edit your code?"

Ernest nodded.

"Well, the end user doesn't need emacs to run your code. Mite is just a development tool."

It began to make sense to Ernest. "Does Mite support everything Moose does?"

Santa shook his head. "There are some limitations, but skimming through your code, it should handle most of what you need. It has attributes with type constraints and coercion, triggers, defaults, and delegation; it has method modifiers; it has roles. In fact, it even has some features Moose doesn't have." His fingers flew into a blur on the keyboard.

use v5.24;
use experimental 'signatures';

package Robot::Alien::Ninja::Face;

use Robot::Alien::Ninja::Mite -all;
use Time::HiRes 'sleep';

my $eye_class = 'Robot::Alien::Ninja::Face';

has eyes =&gt; (
&nbsp;&nbsp;&nbsp;is      =&gt; ro,
&nbsp;&nbsp;&nbsp;isa     =&gt; &quot;Tuple[ $eye_class, $eye_class ]&quot;,
&nbsp;&nbsp;&nbsp;builder =&gt; sub {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return [ $eye_class-&gt;new, $eye_class-&gt;new ]
&nbsp;&nbsp;&nbsp;},
);

# XXX: add eye patch support?

...;

signature_for blink =&gt; (
&nbsp;&nbsp;&nbsp;named =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;time =&gt; 'PositiveNum', { default =&gt; 0.2 },
&nbsp;&nbsp;&nbsp;],
);

sub blink ( $self, $arg ) {
&nbsp;&nbsp;&nbsp;$_-&gt;close for $self-&gt;eyes-&gt;@*;
&nbsp;&nbsp;&nbsp;sleep( $arg-&gt;time );
&nbsp;&nbsp;&nbsp;$_-&gt;open for $self-&gt;eyes-&gt;@*;
}

signature_for wink =&gt; (
&nbsp;&nbsp;&nbsp;named =&gt; [
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;time =&gt; 'PositiveNum',       { default =&gt; 0.4 },
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;eye  =&gt; 'PositiveOrZeroInt', { default =&gt; 0 },
&nbsp;&nbsp;&nbsp;],
);

sub wink ( $self, $arg ) {
&nbsp;&nbsp;&nbsp;my $eye = $self-&gt;eyes-&gt;[ $arg-&gt;eye ];

&nbsp;&nbsp;&nbsp;$eye-&gt;close;
&nbsp;&nbsp;&nbsp;sleep( $arg-&gt;time );
&nbsp;&nbsp;&nbsp;$eye-&gt;open;
}

...;

1;

Santa ran mite compile and ran the test suite again.

Ernest watched as it passed. "Do you mind committing that into a branch? I'd like to go back to my workstation and test it out some more."

Santa nodded. "On your way out, could you send in the next elf?"

Perl Advent Calendar 2022

Fractal Christmas Tree

Create Your Excel using Perl!

Create Your Excel using Perl!

Intro

Preface

Basics

Formatting

Writing data into cells

Outro

How to wrap a camel?

How to wrap a camel?

Wrapping Pure Perl camels

Wrapping camels with XS modules

Looking at the Christmas Numbers

Get some code

Finding Colors

Customize Colors

Open the Color Factory

Conclusion

At the Present Factory

Establishing the Pipe

Data Set Manipulation

Conclusion

Building the Sleigh While Flying It

Building the Sleigh While Flying It

Lapland Packaging Department - Part 2

Task 1. - Preparing the distribution

Task 2: Deploying your Package to the Remote Machines

Lapland Packaging Department - Part 1

Find known, reported vulnerabilities in the modules you use

Check a module

How it works

Contribute!

Links

TWVycnkgQ2hyaXN0bWFzIDop

Perl Birthday Party

Deciphering the code

Secret is compromised!

Make perl speak Spof&#39;s dialect

Conclusion

Naughty or Nice Networks

Relocatable Perl

Install relocatable-perls

Manually

One liner

plenv

How to use relocatable-perls

Conclusion

Create Professional Slideshows with Mojolicious::Plugin::RevealJS

Install and run a Mojolicious server

Use html/Markdown to generate content

Add code snippets in your presentation

Add notes visible only for the author of the presentation:

Bibliography:

Let the Elves Import Your Packages

Santa&#39;s Helper Embrace the Shell

Typical reindeer...

The elves find jp

Conclusion

Download

Usage

The Delivery Map

Make it a Bit Better

The Full Procedure for Santa

Wake up! Time to open presents!

Wake up! Time to open presents!

Traditional alarm Handling

alarm Handling Comes to Christmastown

retry: Never Gonna Give It Up ...

It Was Just A Dream

The Christmas Time Machine

A Terrible Flashback

Go Ask Santa

Try to Deliver Back in the Past

The Perl Time Machine

What did Santa forget?

A Perlmas Tree

How to Buy a Christmas Tree on Christmas Day :-S

A Do-it-Yourself Tree with perl

Make perl speak Spof's dialect

Santa's Helper Embrace the Shell

The elves find `jp`

Traditional `alarm` Handling

`alarm` Handling Comes to Christmastown

`retry`: Never Gonna Give It Up ...

St. Nick's Reindeers Need H2O!