Friday, December 17, 2021, marked the thirty-​fourth birthday of the Perl programming language, and coincidentally this year saw the release of version 5.34. There are plenty of Perl developers out there who haven’t kept up with recent (and not-​so-​recent) improvements to the language and its ecosystem, so I thought I might list a batch. (You may have seen some of these before in May’s post Perl can do that now!”)

The feature pragma

Perl v5.10 was released in December 2007, and with it came feature, a way of enabling new syntax without breaking backward compatibility. You can enable individual features by name (e.g., use feature qw(say fc); for the say and fc keywords), or by using a feature bundle based on the Perl version that introduced them. For example, the following:

use feature ':5.34';

…gives you the equivalent of:

use feature qw(bareword_filehandles bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings);

Boy, that’s a mouthful. Feature bundles are good. The corresponding bundle also gets implicitly loaded if you specify a minimum required Perl version, e.g., with use v5.32;. If you use v5.12; or higher, strict mode is enabled for free. So just say:

use v5.34;

And lastly, one-​liners can use the -E switch instead of -e to enable all features for that version of Perl, so you can say the following on the command line:

perl -E 'say "Hello world!"'

Instead of:

perl -e 'print "Hello world!\n"'

Which is great when you’re trying to save some typing.

The experimental pragma

Sometimes new Perl features need to be driven a couple of releases around the block before their behavior settles. Those experiments are documented in the perlexperiment page, and usually, you need both a use feature (see above) and no warnings statement to safely enable them. Or you can simply pass a list to use experimental of the features you want, e.g.:

use experimental qw(isa postderef signatures);

Ever-​expanding warnings categories

March 2000 saw the release of Perl 5.6, and with it, the expansion of the -w command-​line switch to a system of fine-​grained controls for warning against dubious constructs” that can be turned on and off depending on the lexical scope. What started as 26 main and 20 subcategories has expanded into 31 main and 43 subcategories, including warnings for the aforementioned experimental features.

As the relevant Perl::Critic policy says, Using warnings, and paying attention to what they say, is probably the single most effective way to improve the quality of your code.” If you must violate warnings (perhaps because you’re rehabilitating some legacy code), you can isolate such violations to a small scope and individual categories. Check out the strictures module on CPAN if you’d like to go further and make a safe subset of these categories fatal during development.

Document other recently-​introduced syntax with Syntax::Construct

Not every new bit of Perl syntax is enabled with a feature guard. For the rest, there’s E. Choroba’s Syntax::Construct module on CPAN. Rather than having to remember which version of Perl introduced what, Syntax::Construct lets you declare only what you use and provides a helpful error message if someone tries to run your code on an older unsupported version. Between it and the feature pragma, you can prevent many head-​scratching moments and give your users a chance to either upgrade or workaround.

Make built-​in functions throw exceptions with autodie

Many of Perl’s built-​in functions only return false on failure, requiring the developer to check every time whether a file can be opened or a system command executed. The lexical autodie pragma replaces them with versions that raise an exception with an object that can be interrogated for further details. No matter how many functions or methods deep a problem occurs, you can choose to catch it and respond appropriately. This leads us to…

try/​catch exception handling and Feature::Compat::Try

This year’s Perl v5.34 release introduced experimental try/​catch syntax for exception handling that should look more familiar to users of other languages while handling the issues surrounding using block eval and testing of the special $@ variable. If you need to remain compatible with older versions of Perl (back to v5.14), just use the Feature::Compat::Try module from CPAN to automatically select either v5.34’s native try/​catch or a subset of the functionality provided by Syntax::Keyword::Try.

Pluggable keywords

The abovementioned Syntax::Keyword::Try was made possible by the introduction of a pluggable keyword mechanism in 2010’s Perl v5.12. So was the Future::AsyncAwait asynchronous programming library and the Object::Pad testbed for new object-​oriented Perl syntax. If you’re handy with C and Perl’s XS glue language, check out Paul LeoNerd” Evans’ XS::Parse::Keyword module to get a leg up on developing your own syntax module.

Define packages with versions and blocks

Perl v5.12 also helped reduce clutter by enabling a package namespace declaration to also include a version number, instead of requiring a separate our $VERSION = ...; v5.14 further refined packages to be specified in code blocks, so a namespace declaration can be the same as a lexical scope. Putting the two together gives you:

package Local::NewHotness v1.2.3 {
    ...
}

Instead of:

{
    package Local::OldAndBusted;
    use version 0.77; our $VERSION = version->declare("v1.2.3");
    ...
}

I know which I’d rather do. (Though you may want to also use Syntax::Construct qw(package-version package-block); to help along with older installations as described above.)

The // defined-​or operator

This is an easy win from Perl v5.10:

defined $foo ? $foo : $bar  # replace this
$foo // $bar                # with this

And:

$foo = $bar unless defined $foo  # replace this
$foo //= $bar                    # with this

Perfect for assigning defaults to variables.

state variables only initialize once

Speaking of variables, ever want one to keep its old value the next time a scope is entered, like in a sub? Declare it with state instead of my. Before Perl v5.10, you needed to use a closure instead.

Save some typing with say

Perl v5.10’s bumper crop of enhancements also included the say function, which handles the common use case of printing a string or list of strings with a newline. It’s less noise in your code and saves you four characters. What’s not to love?

Note unimplemented code with ...

The ... ellipsis statement (colloquially yada-​yada”) gives you an easy placeholder for yet-​to-​be-​implemented code. It parses OK but will throw an exception if executed. Hopefully, your test coverage (or at least static analysis) will catch it before your users do.

Loop and enumerate arrays with each, keys, and values

The each, keys, and values functions have always been able to operate on hashes. Perl v5.12 and above make them work on arrays, too. The latter two are mainly for consistency, but you can use each to iterate over an array’s indices and values at the same time:

while (my ($index, $value) = each @array) {
    ...
}

This can be problematic in non-​trivial loops, but I’ve found it helpful in quick scripts and one-liners.

delete local hash (and array) entries

Ever needed to delete an entry from a hash (e.g, an environment variable from %ENV or a signal handler from %SIG) just inside a block? Perl v5.12 lets you do that with delete local.

Paired hash slices

Jumping forward to 2014’s Perl v5.20, the new %foo{'bar', 'baz'} syntax enables you to slice a subset of a hash with its keys and values intact. Very helpful for cherry-​picking or aggregating many hashes into one. For example:

my %args = (
    verbose => 1,
    name    => 'Mark',
    extra   => 'pizza',
);
# don't frob the pizza
$my_object->frob( %args{ qw(verbose name) };

Paired array slices

Not to be left out, you can also slice arrays in the same way, in this case returning indices and values:

my @letters = 'a' .. 'z';
my @subset_kv = %letters[16, 5, 18, 12];
# @subset_kv is now (16, 'p', 5, 'e', 18, 'r', 12, 'l')

More readable dereferencing

Perl v5.20 introduced and v5.24 de-​experimentalized a more readable postfix dereferencing syntax for navigating nested data structures. Instead of using {braces} or smooshing sigils to the left of identifiers, you can use a postfixed sigil-and-star:

push @$array_ref,    1, 2, 3;  # noisy
push @{$array_ref},  1, 2, 3;  # a little easier
push $array_ref->@*, 1, 2, 3;  # read from left to right

So much of web development is slinging around and picking apart complicated data structures via JSON, so I welcome anything like this to reduce the cognitive load.

when as a statement modifier

Starting in Perl v5.12, you can use the experimental switch features when keyword as a postfix modifier. For example:

for ($foo) {
    $a =  1 when /^abc/;
    $a = 42 when /^dna/;
    ...
}

But I don’t recommend when, given, or givens smartmatch operations as they were retconned as experiments in 2013’s Perl v5.18 and have remained so due to their tricky behavior. I wrote about some alternatives using stable syntax back in February.

Simple class inheritance with use parent

Sometimes in older object-​oriented Perl code, you’ll see use base as a pragma to establish inheritance from another class. Older still is the direct manipulation of the package’s special @ISA array. In most cases, both should be avoided in favor of use parent, which was added to core in Perl v5.10.1.

Mind you, if you’re following the Perl object-​oriented tutorial’s advice and have selected an OO system from CPAN, use its subclassing mechanism if it has one. Moose, Moo, and Class::Accessor’s antlers” mode all provide an extends function; Object::Pad provides an :isa attribute on its class keyword.

Test for class membership with the isa operator

As an alternative to the isa() method provided to all Perl objects, Perl v5.32 introduced the experimental isa infix operator:

$my_object->isa('Local::MyClass')
# or
$my_object isa Local::MyClass

The latter can take either a bareword class name or string expression, but more importantly, it’s safer as it also returns false if the left argument is undefined or isn’t a blessed object reference. The older isa() method will throw an exception in the former case and might return true if called as a class method when $my_object is actually a string of a class name that’s the same as or inherits from isa()s argument.

Lexical subroutines

Introduced in Perl v5.18 and de-​experimentalized in 2017’s Perl v5.26, you can now precede sub declarations with my, state, or our. One use of the first two is truly private functions and methods, as described in this 2018 Dave Jacoby blog and as part of Neil Bowers’ 2014 survey of private function techniques.

Subroutine signatures

I’ve written and presented extensively about signatures and alternatives over the past year, so I won’t repeat that here. I’ll just add that the Perl 5 Porters development mailing list has been making a concerted effort over the past month to hash out the remaining issues towards rendering this feature non-​experimental. The popular Mojolicious real-​time web framework also provides a shortcut for enabling signatures and uses them extensively in examples.

Indented here-​documents with <<~

Perl has had shell-​style here-​document” syntax for embedding multi-​line strings of quoted text for a long time. Starting with Perl v5.26, you can precede the delimiting string with a ~ character and Perl will both allow the ending delimiter to be indented as well as strip indentation from the embedded text. This allows for much more readable embedded code such as runs of HTML and SQL. For example:

if ($do_query) {
    my $rows_deleted = $dbh->do(<<~'END_SQL', undef, 42);
      DELETE FROM table
      WHERE status = ?
      END_SQL
    say "$rows_deleted rows were deleted."; 
}

More readable chained comparisons

When I learned math in school, my teachers and textbooks would often describe multiple comparisons and inequalities as a single expression. Unfortunately, when it came time to learn programming every computer language I saw required them to be broken up with a series of and (or &&) operators. With Perl v5.32, this is no more:

if ( $x < $y && $y <= $z ) { ... }  # old way
if ( $x < $y <= $z )       { ... }  # new way

It’s more concise, less noisy, and more like what regular math looks like.

Self-​documenting named regular expression captures

Perl’s expressive regular expression matching and text-​processing prowess are legendary, although overuse and poor use of readability enhancements often turn people away from them (and Perl in general). We often use regexps for extracting data from a matched pattern. For example:

if ( /Time: (..):(..):(..)/ ) {  # parse out values
    say "$1 hours, $2 minutes, $3 seconds";
}

Named capture groups, introduced in Perl v5.10, make both the pattern more obvious and retrieval of its data less cryptic:

if ( /Time: (?<hours>..):(?<minutes>..):(?<seconds>..)/ ) {
    say "$+{hours} hours, $+{minutes} minutes, $+{seconds} seconds";
}

More readable regexp character classes

The /x regular expression modifier already enables better readability by telling the parser to ignore most whitespace, allowing you to break up complicated patterns into spaced-​out groups and multiple lines with code comments. With Perl v5.26 you can specify /xx to also ignore spaces and tabs inside [bracketed] character classes, turning this:

/[d-eg-i3-7]/
/[!@"#$%^&*()=?<>']/

…into this:

/ [d-e g-i 3-7]/xx
/[ ! @ " # $ % ^ & * () = ? <> ' ]/xx

Set default regexp flags with the re pragma

Beginning with Perl v5.14, writing use re '/xms'; (or any combination of regular expression modifier flags) will turn on those flags until the end of that lexical scope, saving you the trouble of remembering them every time.

Non-​destructive substitution with s///r and tr///r

The s/// substitution and tr/// transliteration operators typically change their input directly, often in conjunction with the =~ binding operator:

s/foo/bar/;  # changes the first foo to bar in $_
$baz =~ s/foo/bar/;  # the same but in $baz

But what if you want to leave the original untouched, such as when processing an array of strings with a map? With Perl v5.14 and above, add the /r flag, which makes the substitution on a copy and returns the result:

my @changed = map { s/foo/bar/r } @original;

Unicode case-​folding with fc for better string comparisons

Unicode and character encoding in general are complicated beasts. Perl has handled Unicode since v5.6 and has kept pace with fixes and support for updated standards in the intervening decades. If you need to test if two strings are equal regardless of case, use the fc function introduced in Perl v5.16.

Safer processing of file arguments with <<>>

The <> null filehandle or diamond operator” is often used in while loops to process input per line coming either from standard input (e.g., piped from another program) or from a list of files on the command line. Unfortunately, it uses a form of Perl’s open function that interprets special characters such as pipes (|) that would allow it to insecurely run external commands. Using the <<>> double diamond” operator introduced in Perl v5.22 forces open to treat all command-​line arguments as file names only. For older Perls, the perlop documentation recommends the ARGV::readonly CPAN module.

Safer loading of Perl libraries and modules from @INC

Perl v5.26 removed the ability for all programs to load modules by default from the current directory, closing a security vulnerability originally identified and fixed as CVE-20161238 in previous versions’ included scripts. If your code relied on this unsafe behavior, the v5.26 release notes include steps on how to adapt.

HTTP::Tiny simple HTTP/1.1 client included

To bootstrap access to CPAN on the web in the possible absence of external tools like curl or wget, Perl v5.14 began including the HTTP::Tiny module. You can also use it in your programs if you need a simple web client with no dependencies.

Test2: The next generation of Perl testing frameworks

Forked and refactored from the venerable Test::Builder (the basis for the Test::More library that many are familiar with), Test2 was included in the core module library beginning with Perl v5.26. I’ve experimented recently with using the Test2::Suite CPAN library instead of Test::More and it looks pretty good. I’m also intrigued by Test2::Harness’ support for threading, forking, and preloading modules to reduce test run times.

Task::Kensho: Where to start for recommended Perl modules

This last item may not be included when you install Perl, but it’s where I turn for a collection of well-​regarded CPAN modules for accomplishing a wide variety of common tasks spanning from asynchronous programming to XML. Use it as a starting point or interactively select the mix of libraries appropriate to your project.


And there you have it: a selection of 34 features, enhancements, and improvements for the first 34 years of Perl. What’s your favorite? Did I miss anything? Let me know in the comments.

chocolate bar and sugar cubes on a hand
What about My::Favorite::Module?

I mentioned at the Ephemeral Miniconf last month that as soon as I write about one Perl module (or five), someone inevitably brings up another (or seven) I’ve missed. And of course, it happened again last week: no sooner had I written in passing that I was using Exception::Class than the denizens of the Libera Chat IRC #perl channel insisted I should use Throwable instead for defining my exceptions. (I’ve already blogged about various ways of catching exceptions.)

Why Throwable? Aside from Exception::Class’s author recommending it over his own work due to a nicer, more modern interface,” Throwable is a Moo role, so it’s composable into classes along with other roles instead of mucking about with multiple inheritance. This means that if your exceptions need to do something reusable in your application like logging, you can also consume a role that does that and not have so much duplicate code. (No, I’m not going to pick a favorite logging module; I’ll probably get that wrong too.)

However, since Throwable is a role instead of a class, I would have to define several additional packages in my tiny modulino script from last week, one for each exception class I want. The beauty of Exception::Class is its simple declarative nature: just use it and pass a list of desired class names along with options for attributes and whatnot. What’s needed for simple use cases like mine is a declarative syntax for defining several exception classes without the noise of multiple packages.

Enter Throwable::SugarFactory, a module that enables you to do just that by adding an exception function for declaring exception classes. (There’s also the similarly-​named Throwable::Factory; see the above discussion about never being able to cover everybody’s favorites.) The exception function takes three arguments: the name of the desired exception class as a string, a description, and an optional list of instructions Moo uses to build the class. It might look something like this:

package Local::My::Exceptions;
use Throwable::SugarFactory;

exception GenericError  => 'something bad happened';
exception DetailedError => 'something specific happened' =>
  ( has => [ message => ( is => 'ro' ) ] );

1;

Throwable::SugarFactory takes care of creating constructor functions in Perl-​style snake_case as well as functions for detecting what kind of exception is being caught, so you can use your new exception library like this:

#!/usr/bin/env perl

use experimental qw(isa);
use Feature::Compat::Try;
use JSON::MaybeXS;
use Local::My::Exceptions;

try {
    die generic_error();
}
catch ($e) {
    warn 'whoops!';
}

try {
    die detailed_error( message => 'you got me' );
}
catch ($e) {
    die encode_json( $e->to_hash )
      if $e isa DetailedError and defined $e->message;
    $e->throw if $e->does('Throwable');
    die $e;
}

The above also demonstrates a couple of other Throwable::SugarFactory features. First, you get a to_hash method that returns a hash reference of all exception data, suitable for serializing to JSON. Second, you get all of Throwable’s methods, including throw for re-​throwing exceptions. 

So where does this leave last week’s FOAAS.com modulino client demonstration of object mocking tests? With a little bit of rewriting to define and then use our sweeter exception library, it looks like this. You can review for a description of the rest of its workings.

#!/usr/bin/env perl

package Local::CallFOAAS::Exceptions;
use Throwable::SugarFactory;

BEGIN {
    exception NoMethodError =>
      'no matching WebService::FOAAS method' =>
      ( has => [ method => ( is => 'ro' ) ] );
    exception ServiceError =>
      'error from WebService::FOAAS' =>
      ( has => [ message => ( is => 'ro' ) ] );
}

package Local::CallFOAAS;  # this is a modulino
use Test2::V0;             # enables strict, warnings, utf8

# declare all the new stuff we're using
use feature qw(say state);
use experimental qw(isa postderef signatures);
use Feature::Compat::Try;
use Syntax::Construct qw(non-destructive-substitution);

use WebService::FOAAS ();
use Package::Stash;
BEGIN { Local::CallFOAAS::Exceptions->import() }

my $foaas = Package::Stash->new('WebService::FOAAS');

my $run_as =
    !!$ENV{CPANTEST}       ? 'test'
  : !defined scalar caller ? 'run'
  :                          undef;
__PACKAGE__->$run_as(@ARGV) if defined $run_as;

sub run ( $class, @args ) {
    try { say $class->call_method(@args) }
    catch ($e) {
        die 'No method ', $e->method, "\n"
          if $e isa NoMethodError;
        die 'Service error: ', $e->message, "\n"
          if $e isa ServiceError;
        die "$e\n";
    }
    return;
}

# Utilities

sub methods ($) {
    state @methods = sort map s/^foaas_(.+)/$1/r,
      grep /^foaas_/, $foaas->list_all_symbols('CODE');
    return @methods;
}

sub call_method ( $class, $method = '', @args ) {
    state %methods = map { $_ => 1 } $class->methods();
    die no_method_error( method => $method )
      unless $methods{$method};
    return do {
        try { $foaas->get_symbol("&$method")->(@args) }
        catch ($e) { die service_error( message => $e ) }
    };
}

# Testing

sub test ( $class, @ ) {
    state $stash = Package::Stash->new($class);
    state @tests = sort grep /^_test_/,
      $stash->list_all_symbols('CODE');

    for my $test (@tests) {
        subtest $test => sub {
            try { $class->$test() }
            catch ($e) { diag $e }
        };
    }
    done_testing();
    return;
}

sub _test_can ($class) {
    state @subs = qw(run call_method methods test);
    can_ok $class, \@subs, "can do: @subs";
    return;
}

sub _test_methods ($class) {
    my $mock = mock 'WebService::FOAAS' => ( track => 1 );

    for my $method ( $class->methods() ) {
        $mock->override( $method => 1 );

        ok lives { $class->call_method($method) },
          "$method lives";
        ok scalar $mock->sub_tracking->{$method}->@*,
          "$method called";
    }
    return;
}

sub _test_service_failure ($class) {
    my $mock = mock 'WebService::FOAAS';

    for my $method ( $class->methods() ) {
        $mock->override( $method => sub { die 'mocked' } );

        my $exception =
          dies { $class->call_method($method) };
        isa_ok $exception, [ServiceError],
          "$method throws ServiceError on failure";
        like $exception->message, qr/^mocked/,
          "correct error in $method exception";
    }
    return;
}

1;

[Updated, thanks to Dan Book, Karen Etheridge, and Bob Kleemann] The only goofy bit above is the need to put the exception calls in a BEGIN block and then explicitly call BEGIN { Local::CallFOAAS::Exceptions->import() }. Since the two packages are in the same file, I can’t do a use statement since the implied require would look for a corresponding file or entry in %INC. (You can get around this by messing with %INC directly or through a module like me::inlined that does that messing for you, but for a single-​purpose modulino like this it’s fine.)


happy man funny sticking tongue out

Over the past two years, I’ve gotten back into playing Dungeons & Dragons, the famous tabletop fantasy role-​playing game. As a software developer and musician, one of my favorite character classes to play is the bard, a magical and inspiring performer or wordsmith. The list of basic bardic spells includes Vicious Mockery, enchanting verbal barbs that have the power to psychically damage and disadvantage an opponent even if they don’t understand the words. (Can you see why this is so appealing to a coder?)

Mocking has a role to play in software testing as well, in the form of mock objects that simulate parts of a system that are too brittle, too slow, too complicated, or otherwise too finicky to use in reality. They enable discrete unit testing without relying on dependencies external to the code being tested. Mocks are great for databases, web services, or other network resources where the goal is to test what you wrote, not what’s out in the cloud” somewhere.

Speaking of web services and mocking, one of my favorites is the long-​running FOAAS (link has language not safe for work), a surprisingly expansive RESTful insult service. There’s a corresponding Perl client API, of course, but what I was missing was a handy Perl script to call that API from the terminal command line. So I wrote the following over Thanksgiving break, trying to keep it simple while also showing the basics of mocking such an API. It also demonstrates some newer Perl syntax and testing techniques as well as brian d foys modulino concept from Mastering Perl (second edition, 2014) that marries script and module into a self-​contained executable library.

#!/usr/bin/env perl

package Local::CallFOAAS;  # this is a modulino
use Test2::V0;             # enables strict, warnings, utf8

# declare all the new stuff we're using
use feature qw(say state);
use experimental qw(isa postderef signatures);
use Feature::Compat::Try;
use Syntax::Construct qw(non-destructive-substitution);

use WebService::FOAAS ();
use Package::Stash;
use Exception::Class (
    NoMethodException => {
        alias  => 'throw_no_method',
        fields => 'method',
    },
    ServiceException => { alias => 'throw_service' },
);

my $foaas = Package::Stash->new('WebService::FOAAS');

my $run_as =
    !!$ENV{CPANTEST}       ? 'test'
  : !defined scalar caller ? 'run'
  :                          undef;
__PACKAGE__->$run_as(@ARGV) if defined $run_as;

sub run ( $class, @args ) {
    try { say $class->call_method(@args) }
    catch ($e) {
        die 'No method ', $e->method, "\n"
          if $e isa NoMethodException;
        die 'Service error: ', $e->error, "\n"
          if $e isa ServiceException;
        die "$e\n";
    }
    return;
}

# Utilities

sub methods ($) {
    state @methods = sort map s/^foaas_(.+)/$1/r,
      grep /^foaas_/, $foaas->list_all_symbols('CODE');
    return @methods;
}

sub call_method ( $class, $method = '', @args ) {
    state %methods = map { $_ => 1 } $class->methods();
    throw_no_method( method => $method )
      unless $methods{$method};
    return do {
        try { $foaas->get_symbol("&$method")->(@args) }
        catch ($e) { throw_service( error => $e ) }
    };
}

# Testing

sub test ( $class, @ ) {
    state $stash = Package::Stash->new($class);
    state @tests = sort grep /^_test_/,
      $stash->list_all_symbols('CODE');

    for my $test (@tests) {
        subtest $test => sub {
            try { $class->$test() }
            catch ($e) { diag $e }
        };
    }
    done_testing();
    return;
}

sub _test_can ($class) {
    state @subs = qw(run call_method methods test);
    can_ok( $class, \@subs, "can do: @subs" );
    return;
}

sub _test_methods ($class) {
    my $mock = mock 'WebService::FOAAS' => ( track => 1 );

    for my $method ( $class->methods() ) {
        $mock->override( $method => 1 );

        ok lives { $class->call_method($method) },
          "$method lives";
        ok scalar $mock->sub_tracking->{$method}->@*,
          "$method called";
    }
    return;
}

sub _test_service_failure ($class) {
    my $mock = mock 'WebService::FOAAS';

    for my $method ( $class->methods() ) {
        $mock->override( $method => sub { die 'mocked' } );

        my $exception =
          dies { $class->call_method($method) };
        isa_ok $exception, ['ServiceException'],
          "$method throws ServiceException on failure";
        like $exception->error, qr/^mocked/,
          "correct error in $method exception";
    }
    return;
}

1;

Let’s walk through the code above.

Preliminaries

First, there’s a generic shebang line to indicate that Unix and Linux systems should use the perl executable found in the user’s PATH via the env command. I declare a package name (in the Local:: namespace) so as not to pollute the default main package of other scripts that might want to require this as a module. Then I use the Test2::V0 bundle from Test2::Suite since the embedded testing code uses many of its functions. This also has the side effect of enabling the strict, warnings, and utf8 pragmas, so there’s no need to explicitly use them here.

(Why Test2 instead of Test::More and its derivatives and add-​ons? Both are maintained by the same author, who recommends the former. I’m seeing more and more modules using it, so I thought this would be a great opportunity to learn.)

I then declare all the new-​ish Perl features I’d like to use that need to be explicitly enabled so as not to sacrifice backward compatibility with older versions of Perl 5. As of this writing, some of these features (the isa class instance operator, named argument subroutine signatures, and try/​catch exception handling syntax) are considered experimental, with the latter enabled in older versions of Perl via the Feature::Compat::Try module. The friendlier postfix dereferencing syntax was mainlined in Perl version 5.24, but versions 5.20 and 5.22 still need it experimental. Finally, I use Syntax::Construct to announce the /r flag for non-​destructive regular expression text substitutions introduced in version 5.14.

Next, I bring in the aforementioned FOAAS Perl API without importing any of its functions, Package::Stash to make metaprogramming easier, and a couple of exception classes so that the command line function and other consumers might better tell what caused a failure. In preparation for the methods below dynamically discovering what functions are provided by WebService::FOAAS, I gather up its symbol table (or stash) into the $foaas variable.

The next block determines how, if at all, I’m going to run the code as a script. If the CPANTEST environment variable is set, I’ll call the test class method sub, but if there’s no subroutine calling me I’ll execute the run class method. Either will receive the command line arguments from @ARGV. If neither of these conditions is true, do nothing; the rest of the code is method declarations.

Modulino methods, metaprogramming, and exceptions

The first of these is the run method. It’s a thin wrapper around the call_method class method detailed below, either outputting its result or dieing with an appropriate error depending on the class of exception thrown. Although I chose not to write tests for this output, future tests might call this method and catch these rethrown exceptions to match against them. The messages end with a \n newline character so die knows not to append the current script line number.

Next is a utility method called methods that uses Package::Stash’s list_all_symbols to retrieve the names of all named CODE blocks (i.e., subs) from WebService::FOAAS’s symbol table. Reading from right to left, these are then filtered with grep to only find those beginning in foaas_ and then transformed with map to remove that prefix. The list is then sorted and stored in a state variable and returned so it need not be initialized again.

(As an aside, although perlcritic sternly warns against it I’ve chosen the expression forms of grep and map here over their block forms for simplicity’s sake. It’s OK to bend the rules if you have a good reason.)

sub call_method is where the real action takes place. Its parameters are the class that called it, the name of a FOAAS $method (defaulted to the empty string), and an array of optional arguments in @args. I build a hash or associative array from the earlier methods method which I then use to see if the passed method name is one I know about. If not, I throw a NoMethodException using the throw_no_method alias function created when I used Exception::Class at the beginning. Using a function instead of NoMethodException->throw() means that it’s checked at compile time rather than runtime, catching typos.

I get the subroutine (denoted by a & sigil) named by $method from the $foaas stash and pass it any further received arguments from @args. If that WebService::FOAAS subroutine throws an exception it’ll be caught and re-​thrown as a ServiceException; otherwise call_method returns the result. It’s up to the caller to determine what, if anything, to do with that result or any thrown exceptions.

Testing the modulino with mocks

This is where I start using those Test2::Suite tools I mentioned at the beginning. The test class method starts by building a filtered list of all subs beginning with _test_ in the current class, much like methods did above with WebService::FOAAS. I then loop through that list of subs, running each as a subtest containing a class method with any exceptions reported as diagnostics.

The rest of the modulino is subtest methods, starting with a simple _test_can sanity check for the public methods in the class. Following that is _test_methods, which starts by mocking the WebService::FOAAS package and telling Test2::Mock I want to track any added, overridden, or set subs. I then loop through all the method names returned by the methods class method, overrideing each one to return a simple true value. I then test passing those names to call_method and use the hash reference returned by sub_tracking to check that the overridden sub was called. This seems a lot simpler than the Test::Builder-based mocking libraries I’ve tried like Test::MockModule and Test::MockObject.

_test_service_failure acts in much the same way, checking that call_method correctly throws ServiceExceptions if the wrapped WebService::FOAAS function dies. The main difference is that the mocked WebService::FOAAS subs are now overridden with a code reference (sub { die 'mocked' }), which call_method uses to populate the rethrown ServiceExceptions error field.

Wrapping up

With luck, this article has given you some ideas, whether it’s in making scripts (perhaps legacy code) testable to improve them, or writing better unit tests that mock dependencies, or delving a little into metaprogramming so you can dynamically support and test new features of said dependencies. I hope you haven’t come away too offended, at least. Let me know in the comments what you think.

depth of field photography of brown tree logs

A recent Lobsters post lauding the virtues of AWK reminded me that although the language is powerful and lightning-​fast, I usually find myself exceeding its capabilities and reaching for Perl instead. One such application is analyzing voluminous log files such as the ones generated by this blog. Yes, WordPress has stats, but I’ve never let reinvention of the wheel get in the way of a good programming exercise.

So I whipped this script up on Sunday night while watching RuPaul’s Drag Race reruns. It parses my Apache web server log files and reports on hits from week to week.

#!/usr/bin/env perl

use strict;
use warnings;
use Syntax::Construct 'operator-double-diamond';
use Regexp::Log::Common;
use DateTime::Format::HTTP;
use List::Util 1.33 'any';
use Number::Format 'format_number';

my $parser = Regexp::Log::Common->new(
    format  => ':extended',
    capture => [qw<req ts status>],
);
my @fields      = $parser->capture;
my $compiled_re = $parser->regexp;

my @skip_uri_patterns = qw<
  ^/+robots.txt
  [-\w]*sitemap[-\w]*.xml
  ^/+wp-
  /feed/?$
  ^/+?rest_route=
>;

my ( %count, %week_of );
while ( <<>> ) {
    my %log;
    @log{@fields} = /$compiled_re/;

    # only interested in successful or cached requests
    next unless $log{status} =~ /^2/ or $log{status} == 304;

    my ( $method, $uri, $protocol ) = split ' ', $log{req};
    next unless $method eq 'GET';
    next if any { $uri =~ $_ } @skip_uri_patterns;

    my $dt  = DateTime::Format::HTTP->parse_datetime( $log{ts} );
    my $key = sprintf '%u-%02u', $dt->week;

    # get first date of each week
    $week_of{$key} ||= $dt->date;
    $count{$key}++;
}

printf "Week of %s: % 10s\n", $week_of{$_}, format_number( $count{$_} )
  for sort keys %count;

Here’s some sample output:

Week of 2021-07-31:      2,672
Week of 2021-08-02:     16,222
Week of 2021-08-09:     12,609
Week of 2021-08-16:     17,714
Week of 2021-08-23:     14,462
Week of 2021-08-30:     11,758
Week of 2021-09-06:     14,811
Week of 2021-09-13:        407

I first started prototyping this on the command line as if it were an awk one-​liner by using the perl -n and -a flags. The former wraps code in a while loop over the <> diamond operator”, processing each line from standard input or files passed as arguments. The latter splits the fields of the line into an array named @F. It looked something like this while I was listing URIs (locations on the website):

gunzip -c ~/logs/phoenixtrap.com-ssl_log-*.gz | \
perl -anE 'say $F[6]'

But once I realized I’d need to filter out a bunch of URI patterns and do some aggregation by date, I turned it into a script and turned to CPAN.

There I found Regexp::Log::Common and DateTime::Format::HTTP, which let me pull apart the Apache log format and its timestamp strings without having to write even more complicated regular expressions myself. (As noted above, this was already a wheel-​reinvention exercise; no need to compound that further.)

Regexp::Log::Common builds a compiled regular expression based on the log format and fields you’re interested in, so that’s the constructor on lines 11 through 14. The expression then returns those fields as a list, which I’m assigning to a hash slice with those field names as keys in line 29. I then skip over requests that aren’t successful or browser cache hits, skip over requests that don’t GET web pages or other assets (e.g., POSTs to forms or updating other resources), and skip over the URI patterns mentioned earlier.

(Those patterns are worth a mention: they include the robots.txt and sitemap XML files used by search engine indexers, WordPress administration pages, files used by RSS newsreaders subscribed to my blog, and routes used by the Jetpack WordPress add-​on. If you’re adapting this for your site you might need to customize this list based on what software you use to run it.)

Lines 38 and 39 parse the timestamp from the log into a DateTime object using DateTime::Format::HTTP and then build the key used to store the per-​week hit count. The last lines of the loop then grab the first date of each new week (assuming the log is in chronological order) and increment the count. Once finished, lines 46 and 47 provide a report sorted by week, displaying it as a friendly Week of date” and the hit counts aligned to the right with sprintf. Number::Format’s format_number function displays the totals with thousands separators.

Update: After this was initially published. astute reader Chris McGowan noted that I had a bug where $log{status} was assigned the value 304 with the = operator rather than compared with ==. He also suggested I use the double-​diamond <<>> operator introduced in Perl v5.22.0 to avoid maliciously-​named files. Thanks, Chris!

Room for improvement

DateTime is a very powerful module but this comes at a price of speed and memory. Something simpler like Date::WeekNumber should yield performance improvements, especially as my logs grow (here’s hoping). It requires a bit more manual massaging of the log dates to convert them into something the module can use, though:

#!/usr/bin/env perl

use strict;
use warnings;
use Syntax::Construct qw<
  operator-double-diamond
  regex-named-capture-group
>;
use Regexp::Log::Common;
use Date::WeekNumber 'iso_week_number';
use List::Util 1.33 'any';
use Number::Format 'format_number';

my $parser = Regexp::Log::Common->new(
    format  => ':extended',
    capture => [qw<req ts status>],
);
my @fields      = $parser->capture;
my $compiled_re = $parser->regexp;

my @skip_uri_patterns = qw<
  ^/+robots.txt
  [-\w]*sitemap[-\w]*.xml
  ^/+wp-
  /feed/?$
  ^/+?rest_route=
>;

my %month = (
    Jan => '01',
    Feb => '02',
    Mar => '03',
    Apr => '04',
    May => '05',
    Jun => '06',
    Jul => '07',
    Aug => '08',
    Sep => '09',
    Oct => '10',
    Nov => '11',
    Dec => '12',
);

my ( %count, %week_of );
while ( <<>> ) {
    my %log;
    @log{@fields} = /$compiled_re/;

    # only interested in successful or cached requests
    next unless $log{status} =~ /^2/ or $log{status} == 304;

    my ( $method, $uri, $protocol ) = split ' ', $log{req};
    next unless $method eq 'GET';
    next if any { $uri =~ $_ } @skip_uri_patterns;

    # convert log timestamp to YYYY-MM-DD
    # for Date::WeekNumber
    $log{ts} =~ m!^
      (?<day>\d\d) /
      (?<month>...) /
      (?<year>\d{4}) : !x;
    my $date = "$+{year}-$month{ $+{month} }-$+{day}";

    my $week = iso_week_number($date);
    $week_of{$week} ||= $date;
    $count{$week}++;
}

printf "Week of %s: % 10s\n", $week_of{$_}, format_number( $count{$_} )
  for sort keys %count;

It looks almost the same as the first version, with the addition of a hash to convert month names to numbers and the actual conversion (using named regular expression capture groups for readability, using Syntax::Construct to check for that feature). On my server, this results in a ten- to eleven-​second savings when processing two months of compressed logs.

What’s next? Pretty graphs? Drilling down to specific blog posts? Database storage for further queries and analysis? Perl and CPAN make it possible to go far beyond what you can do with AWK. What would you add or change? Let me know in the comments.