Vicious (test) mockery of a Perl modulino
Tags: perl, testing, mocking, metaprogramming
Published: 2021-11-30 16:24:04

---
title: Vicious (test) mockery of a Perl modulino
published: true
date: 2021-11-30 15:00:00 UTC
tags: Perl,testing,mocking,metaprogramming
canonical_url: https://phoenixtrap.com/2021/11/30/vicious-test-mockery-of-a-perl-modulino/
cover_image: https://dev-to-uploads.s3.amazonaws.com/uploads/articles/23zbuop0an8pn8p226d5.jpeg
---

Over the past two years, I’ve gotten back into playing [Dungeons & Dragons](https://dnd.wizards.com/), the famous tabletop fantasy role-playing game. As a software developer and musician, one of my favorite character classes to play is the [bard](https://www.dndbeyond.com/classes/bard), a magical and inspiring performer or wordsmith. The list of basic bardic spells includes [Vicious Mockery](https://www.dndbeyond.com/spells/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](https://en.wikipedia.org/wiki/Mock_object) 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](https://en.wikipedia.org/wiki/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](https://foaas.com/) (link has language not safe for work), a surprisingly expansive [RESTful](https://restfulapi.net/) insult service. There’s a corresponding [Perl client API](https://metacpan.org/pod/WebService::FOAAS), 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](https://en.wikipedia.org/wiki/Thanksgiving_(United_States)) 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 foy](https://briandfoy.github.io/)’s [modulino](https://perlmaven.com/modulino-both-script-and-module) concept from _[Mastering Perl](https://www.masteringperl.org/) (second edition, 2014)_ that marries script and module into a self-contained [executable library](https://rosettacode.org/wiki/Executable_library).

```perl
#!/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](https://en.wikipedia.org/wiki/Shebang_(Unix)) 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](https://phoenixtrap.com/2021/04/13/avoid-cpan-conflicts-in-your-personal-perl-modules/)) 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](https://metacpan.org/pod/Test2::V0) from [Test2::Suite](https://metacpan.org/pod/Test2::Suite) since the embedded testing code uses many of its functions. This also has the side effect of enabling the [strict](https://perldoc.perl.org/strict), [warnings](https://perldoc.perl.org/warnings), and [utf8](https://perldoc.perl.org/utf8) pragmas, so there’s no need to explicitly `use` them here.

(Why [Test2](https://metacpan.org/pod/Test2) instead of [Test::More](https://metacpan.org/pod/Test::More) and its derivatives and add-ons? Both are [maintained by the same author](https://metacpan.org/author/EXODIST), 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](https://perldoc.perl.org/perlpolicy#BACKWARD-COMPATIBILITY-AND-DEPRECATION) with older versions of Perl 5. As of this writing, some of these features (the [`isa` class instance operator](https://perldoc.perl.org/perlop#Class-Instance-Operator), named argument [subroutine signatures](https://perldoc.perl.org/perlsub#Signatures), and [`try`/`catch` exception handling](https://perldoc.perl.org/perlsyn#Try-Catch-Exception-Handling) syntax) are considered [`experimental`](https://perldoc.perl.org/experimental), with the latter enabled in older versions of Perl via the [Feature::Compat::Try](https://metacpan.org/pod/Feature::Compat::Try) module. The friendlier [postfix dereferencing](https://perldoc.pl/perlref#Postfix-Dereference-Syntax) syntax was [mainlined in Perl version 5.24](https://perldoc.perl.org/perl5240delta#Postfix-dereferencing-is-no-longer-experimental), 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](https://perldoc.perl.org/perlop#s/PATTERN/REPLACEMENT/msixpodualngcer) [introduced in version 5.14](https://perldoc.perl.org/perl5140delta#Non-destructive-substitution).

Next, I bring in the aforementioned FOAAS Perl API without importing any of its functions, [Package::Stash](https://metacpan.org/pod/Package::Stash) to make [metaprogramming](https://en.wikipedia.org/wiki/Metaprogramming) easier, and a couple of [exception classes](https://metacpan.org/pod/Exception::Class) 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](https://metacpan.org/pod/WebService::FOAAS), I [gather up](https://metacpan.org/pod/Package::Stash#new-%24package_name) 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](https://perldoc.perl.org/functions/caller) me I’ll execute the `run` class method. Either will receive the [command line arguments from `@ARGV`](https://perldoc.perl.org/variables/@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 `die`ing 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., `sub`s) from WebService::FOAAS’s symbol table. Reading from right to left, these are then filtered with `grep` to only find those [beginning in `foaas_`](https://metacpan.org/pod/WebService::FOAAS#AVAILABLE-METHODS) and then transformed with `map` to remove that prefix. The list is then `sort`ed 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](https://metacpan.org/pod/Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep) [forms](https://metacpan.org/pod/Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap) for simplicity’s sake. It’s OK to [bend the rules](https://metacpan.org/pod/Perl::Critic#BENDING-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](https://metacpan.org/pod/Exception::Class#DECLARING-EXCEPTION-CLASSES) 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](https://metacpan.org/pod/Test2::Suite#Test2::V#) I mentioned at the beginning. The `test` class method starts by building a filtered list of all `sub`s beginning with `_test_` in the current class, much like `methods` did above with WebService::FOAAS. I then loop through that list of `sub`s, running each as a [`subtest`](https://metacpan.org/pod/Test2::V0#SUBTEST) containing a class method with any exceptions [reported as diagnostics](https://metacpan.org/pod/Test2::Tools::Basic#diag(@messages)).

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 `mock`ing the WebService::FOAAS package and telling Test2::Mock I want to `track` any added, overridden, or set `sub`s. I then loop through all the method names returned by the `methods` class method, `override`ing 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](https://metacpan.org/pod/Test::Builder)-based mocking libraries I’ve tried like [Test::MockModule](https://metacpan.org/pod/Test::MockModule) and [Test::MockObject](https://metacpan.org/pod/Test::MockObject).

`_test_service_failure` acts in much the same way, checking that `call_method` correctly throws `ServiceException`s if the wrapped WebService::FOAAS function `die`s. The main difference is that the mocked WebService::FOAAS `sub`s are now overridden with a code reference (`sub { die 'mocked' }`), which `call_method` uses to populate the rethrown `ServiceException`’s `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.