arrow communication direction display

When I first start­ed writ­ing Perl in my ear­ly 20’s, I tend­ed to fol­low a lot of the struc­tured pro­gram­ming con­ven­tions I had learned in school through Pascal, espe­cial­ly the notion that every func­tion has a sin­gle point of exit. For example:

sub double_even_number {
    # not using signatures, this is mid-1990's code
    my $number = shift;

    if (not $number % 2) {
        $number *= 2;
    }

    return $number; 
}

This could get pret­ty con­vo­lut­ed, espe­cial­ly if I was doing some­thing like val­i­dat­ing mul­ti­ple argu­ments. And at the time I didn’t yet grok how to han­dle excep­tions with eval and die, so I’d end up with code like:

sub print_postal_address {
    # too many arguments, I know
    my ($name, $street1, $street2, $city, $state, $zip) = @_;
    # also this notion of addresses is naive and US-centric

    my $error;

    if (!$name) {
        $error = 'no name';
    }
    else {
        print "$name\n";

        if (!$street1) {
            $error = 'no street';
        }
        else {
            print "$street1\n";

            if ($street2) {
                print "$street2\n";
            }

            if (!$city) {
                $error = 'no city';
            }
            else {
                print "$city, ";

                if (!$state) {
                    $error = 'no state';
                }
                else {
                    print "$state ";

                    if (!$zip) {
                        $error = 'no ZIP code';
                    }
                    else {
                        print "$zip\n";
                    }
                }
            }
        }
    }

    return $error;
}

What a mess. Want to count all those braces to make sure they’re bal­anced? This is some­times called the arrow anti-​pattern, with the arrowhead(s) being the most nest­ed state­ment. The default ProhibitDeepNests perlcritic pol­i­cy is meant to keep you from doing that.

The way out (lit­er­al­ly) is guard claus­es: check­ing ear­ly if some­thing is valid and bail­ing out quick­ly if not. The above exam­ple could be written:

sub print_postal_address {
    my ($name, $street1, $street2, $city, $state, $zip) = @_;

    if (!$name) {
        return 'no name';
    }
    if (!$street1) {
        return 'no street1';
    }
    if (!$city) {
        return 'no city';
    }
    if (!$state) {
        return 'no state';
    }
    if (!$zip) {
        return 'no zip';
    }

    print join "\n",
      $name,
      $street1,
      $street2 ? $street2 : (),
      "$city, $state $zip\n";

    return;
}

With Perl’s state­ment mod­i­fiers (some­times called post­fix con­trols) we can do even better:

    ...

    return 'no name'    if !$name;
    return 'no street1' if !$street1;
    return 'no city'    if !$city;
    return 'no state'   if !$state;
    return 'no zip'     if !$zip;

    ...

(Why if instead of unless? Because the lat­ter can be con­fus­ing with double-​negatives.)

Guard claus­es aren’t lim­it­ed to the begin­nings of func­tions or even exit­ing func­tions entire­ly. Often you’ll want to skip or even exit ear­ly con­di­tions in a loop, like this exam­ple that process­es files from stan­dard input or the com­mand line:

while (<>) {
    next if /^SKIP THIS LINE: /;
    last if /^END THINGS HERE$/;

    ...
}

Of course, if you are val­i­dat­ing func­tion argu­ments, you should con­sid­er using actu­al sub­rou­tine sig­na­tures if you have a Perl new­er than v5.20 (released in 2014), or one of the oth­er type val­i­da­tion solu­tions if not. Today I would write that postal func­tion like this, using Type::Params for val­i­da­tion and named arguments:

use feature qw(say state); 
use Types::Standard 'Str';
use Type::Params 'compile_named';

sub print_postal_address {
    state $check = compile_named(
        name    => Str,
        street1 => Str,
        street2 => Str, {optional => 1},
        city    => Str,
        state   => Str,
        zip     => Str,
    );
    my $arg = $check->(@_);

    say join "\n",
      $arg->{name},
      $arg->{street1},
      $arg->{street2} ? $arg->{street2} : (),
      "$arg->{city}, $arg->{state} $arg->{zip}";

    return;
}

print_postal_address(
    name    => 'J. Random Hacker',
    street1 => '123 Any Street',
    city    => 'Somewhereville',
    state   => 'TX',
    zip     => 12345,
);

Note that was this part of a larg­er pro­gram, I’d wrap that print_postal_address call in a try block and catch excep­tions such as those thrown by the code ref­er­ence $check gen­er­at­ed by compile_named. This high­lights one con­cern of guard claus­es and oth­er return ear­ly” pat­terns: depend­ing on how much has already occurred in your pro­gram, you may have to per­form some resource cleanup either in a catch block or some­thing like Syntax::Keyword::Try’s finally block if you need to tidy up after both suc­cess and failure.

I men­tioned in pass­ing last week that the next major release of Perl, v5.36, is set to enable warnings by default for code that opts in to use v5.35; or above. Commemorating Perl’s 34th birth­day the week before that, I not­ed that the warn­ings sys­tem has been get­ting ever finer-​grained since its intro­duc­tion in 2000. And fel­low Perl blog­ger and CPAN author Tom Wyant has been cat­a­loging his favorites over the past sev­er­al months — the lat­est as of this writ­ing was on the ambigu­ous” cat­e­go­ry of warn­ings, and you can find links to pre­vi­ous entries in his series at the bot­tom of that post.

It occurred to me after­ward that there may be some con­fu­sion between the warnings prag­ma and the relat­ed warn func­tion for report­ing arbi­trary run­time errors. warn out­puts its argu­ments to the stan­dard error (STDERR) stream, or if it’s not giv­en any then you get a string with any excep­tion from [email protected] ($EVAL_ERROR under use English) fol­lowed by a tab and then “...caught at <file> line x.” If that’s emp­ty too, a plain warn just says, Warning: something's wrong at <file> line x.”, which isn’t exact­ly help­ful, but then again you didn’t give it much to go on.

warn out­put doesn’t have to go to STDERR, and this is where the rela­tion to the warn­ings prag­ma comes in because both are gov­erned by the __WARN__ sig­nal han­dler in the %SIG hash. Normally, you might opt to only dis­play run­time warn­ings if a debug­ging flag is set, like so:

#!/usr/bin/env perl

use strict;
use warnings;

my $DEBUG = 0;
$SIG{__WARN__} = sub { warn @_ if $DEBUG };
warn 'shhh'; # silenced

$DEBUG = 1;
warn 'hello warnings';

But if you set that sig­nal han­dler in a BEGIN block, it catch­es compile-​time warn­ings too, in which case flip­ping a flag after the fact has no effect — the compiler’s already run:

#!/usr/bin/env perl

use strict;
use warnings;

my $DEBUG = 0;
BEGIN { $SIG{__WARN__} = sub { warn @_ if $DEBUG } }
my $foo = 'hello';
my $foo = 'world'; # no warning issued here

$DEBUG = 1;
my $foo = 'howdy'; # still nothing

By the way, both __WARN__ and __DIE__ hooks are also used by the Carp mod­ule and its friends, so you can use the same tech­nique with their enhanced output:

#!/usr/bin/env perl

use strict;
use warnings;
use Carp qw(carp cluck);

my $DEBUG = 0;
BEGIN { $SIG{__WARN__} = sub { warn @_ if $DEBUG } }
carp 'quiet fish';

$DEBUG = 1;
loud_chicken();

sub loud_chicken {
    cluck 'here comes a stack trace';
}

You could use these as step­ping stones towards a debug log for larg­er appli­ca­tions, but at that point, I’d sug­gest look­ing into one of the log­ging mod­ules on CPAN like Log::Log4perl (not to be con­fused with that lately-​problematic Java library), Log::Dispatch (which can be wired into Log4perl), or some­thing else to suit your needs.

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

I men­tioned at the Ephemeral Miniconf last month that as soon as I write about one Perl mod­ule (or five), some­one inevitably brings up anoth­er (or sev­en) I’ve missed. And of course, it hap­pened again last week: no soon­er had I writ­ten in pass­ing that I was using Exception::Class than the denizens of the Libera Chat IRC #perl chan­nel insist­ed I should use Throwable instead for defin­ing my excep­tions. (I’ve already blogged about var­i­ous ways of catch­ing excep­tions.)

Why Throwable? Aside from Exception::Class’s author rec­om­mend­ing it over his own work due to a nicer, more mod­ern inter­face,” Throwable is a Moo role, so it’s com­pos­able into class­es along with oth­er roles instead of muck­ing about with mul­ti­ple inher­i­tance. This means that if your excep­tions need to do some­thing reusable in your appli­ca­tion like log­ging, you can also con­sume a role that does that and not have so much dupli­cate code. (No, I’m not going to pick a favorite log­ging mod­ule; I’ll prob­a­bly get that wrong too.)

However, since Throwable is a role instead of a class, I would have to define sev­er­al addi­tion­al packages in my tiny mod­uli­no script from last week, one for each excep­tion class I want. The beau­ty of Exception::Class is its sim­ple declar­a­tive nature: just use it and pass a list of desired class names along with options for attrib­ut­es and what­not. What’s need­ed for sim­ple use cas­es like mine is a declar­a­tive syn­tax for defin­ing sev­er­al excep­tion class­es with­out the noise of mul­ti­ple packages.

Enter Throwable::SugarFactory, a mod­ule that enables you to do just that by adding an exception func­tion for declar­ing excep­tion class­es. (There’s also the similarly-​named Throwable::Factory; see the above dis­cus­sion about nev­er being able to cov­er everybody’s favorites.) The exception func­tion takes three argu­ments: the name of the desired excep­tion class as a string, a descrip­tion, and an option­al list of instruc­tions Moo uses to build the class. It might look some­thing 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 cre­at­ing con­struc­tor func­tions in Perl-​style snake_case as well as func­tions for detect­ing what kind of excep­tion is being caught, so you can use your new excep­tion 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 demon­strates a cou­ple of oth­er Throwable::SugarFactory fea­tures. First, you get a to_hash method that returns a hash ref­er­ence of all excep­tion data, suit­able for seri­al­iz­ing to JSON. Second, you get all of Throwable’s meth­ods, includ­ing throw for re-​throwing exceptions. 

So where does this leave last week’s FOAAS.com mod­uli­no client demon­stra­tion of object mock­ing tests? With a lit­tle bit of rewrit­ing to define and then use our sweet­er excep­tion library, it looks like this. You can review for a descrip­tion 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 explic­it­ly call BEGIN { Local::CallFOAAS::Exceptions->import() }. Since the two pack­ages are in the same file, I can’t do a use state­ment since the implied require would look for a cor­re­spond­ing file or entry in %INC. (You can get around this by mess­ing with %INC direct­ly or through a mod­ule like me::inlined that does that mess­ing for you, but for a single-​purpose mod­uli­no like this it’s fine.)


happy man funny sticking tongue out

Over the past two years, I’ve got­ten back into play­ing Dungeons & Dragons, the famous table­top fan­ta­sy role-​playing game. As a soft­ware devel­op­er and musi­cian, one of my favorite char­ac­ter class­es to play is the bard, a mag­i­cal and inspir­ing per­former or word­smith. The list of basic bardic spells includes Vicious Mockery, enchant­i­ng ver­bal barbs that have the pow­er to psy­chi­cal­ly dam­age and dis­ad­van­tage an oppo­nent even if they don’t under­stand the words. (Can you see why this is so appeal­ing to a coder?)

Mocking has a role to play in soft­ware test­ing as well, in the form of mock objects that sim­u­late parts of a sys­tem that are too brit­tle, too slow, too com­pli­cat­ed, or oth­er­wise too finicky to use in real­i­ty. They enable dis­crete unit test­ing with­out rely­ing on depen­den­cies exter­nal to the code being test­ed. Mocks are great for data­bas­es, web ser­vices, or oth­er net­work resources where the goal is to test what you wrote, not what’s out in the cloud” somewhere.

Speaking of web ser­vices and mock­ing, one of my favorites is the long-​running FOAAS (link has lan­guage not safe for work), a sur­pris­ing­ly expan­sive RESTful insult ser­vice. There’s a cor­re­spond­ing Perl client API, of course, but what I was miss­ing was a handy Perl script to call that API from the ter­mi­nal com­mand line. So I wrote the fol­low­ing over Thanksgiving break, try­ing to keep it sim­ple while also show­ing the basics of mock­ing such an API. It also demon­strates some new­er Perl syn­tax and test­ing tech­niques as well as bri­an d foys mod­uli­no con­cept from Mastering Perl (sec­ond edi­tion, 2014) that mar­ries script and mod­ule into a self-​contained exe­cutable 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 gener­ic she­bang line to indi­cate that Unix and Linux sys­tems should use the perl exe­cutable found in the user’s PATH via the env com­mand. I declare a pack­age name (in the Local:: name­space) so as not to pol­lute the default main pack­age of oth­er scripts that might want to require this as a mod­ule. Then I use the Test2::V0 bun­dle from Test2::Suite since the embed­ded test­ing code uses many of its func­tions. This also has the side effect of enabling the strict, warn­ings, and utf8 prag­mas, so there’s no need to explic­it­ly use them here.

(Why Test2 instead of Test::More and its deriv­a­tives and add-​ons? Both are main­tained by the same author, who rec­om­mends the for­mer. I’m see­ing more and more mod­ules using it, so I thought this would be a great oppor­tu­ni­ty to learn.)

I then declare all the new-​ish Perl fea­tures I’d like to use that need to be explic­it­ly enabled so as not to sac­ri­fice back­ward com­pat­i­bil­i­ty with old­er ver­sions of Perl 5. As of this writ­ing, some of these fea­tures (the isa class instance oper­a­tor, named argu­ment sub­rou­tine sig­na­tures, and try/​catch excep­tion han­dling syn­tax) are con­sid­ered experimental, with the lat­ter enabled in old­er ver­sions of Perl via the Feature::Compat::Try mod­ule. The friend­lier post­fix deref­er­enc­ing syn­tax was main­lined in Perl ver­sion 5.24, but ver­sions 5.20 and 5.22 still need it exper­i­men­tal. Finally, I use Syntax::Construct to announce the /r flag for non-​destructive reg­u­lar expres­sion text sub­sti­tu­tions intro­duced in ver­sion 5.14.

Next, I bring in the afore­men­tioned FOAAS Perl API with­out import­ing any of its func­tions, Package::Stash to make metapro­gram­ming eas­i­er, and a cou­ple of excep­tion class­es so that the com­mand line func­tion and oth­er con­sumers might bet­ter tell what caused a fail­ure. In prepa­ra­tion for the meth­ods below dynam­i­cal­ly dis­cov­er­ing what func­tions are pro­vid­ed by WebService::FOAAS, I gath­er up its sym­bol table (or stash) into the $foaas variable.

The next block deter­mines how, if at all, I’m going to run the code as a script. If the CPANTEST envi­ron­ment vari­able is set, I’ll call the test class method sub, but if there’s no sub­rou­tine call­ing me I’ll exe­cute the run class method. Either will receive the com­mand line argu­ments from @ARGV. If nei­ther of these con­di­tions is true, do noth­ing; 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 wrap­per around the call_method class method detailed below, either out­putting its result or dieing with an appro­pri­ate error depend­ing on the class of excep­tion thrown. Although I chose not to write tests for this out­put, future tests might call this method and catch these rethrown excep­tions to match against them. The mes­sages end with a \n new­line char­ac­ter so die knows not to append the cur­rent script line number.

Next is a util­i­ty 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 sym­bol table. Reading from right to left, these are then fil­tered with grep to only find those begin­ning in foaas_ and then trans­formed with map to remove that pre­fix. The list is then sorted and stored in a state vari­able and returned so it need not be ini­tial­ized again.

(As an aside, although perlcritic stern­ly warns against it I’ve cho­sen the expres­sion forms of grep and map here over their block forms for sim­plic­i­ty’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 para­me­ters are the class that called it, the name of a FOAAS $method (default­ed to the emp­ty string), and an array of option­al argu­ments in @args. I build a hash or asso­cia­tive array from the ear­li­er 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 func­tion cre­at­ed when I used Exception::Class at the begin­ning. Using a func­tion instead of NoMethodException->throw() means that it’s checked at com­pile time rather than run­time, catch­ing typos.

I get the sub­rou­tine (denot­ed by a & sig­il) named by $method from the $foaas stash and pass it any fur­ther received argu­ments from @args. If that WebService::FOAAS sub­rou­tine throws an excep­tion it’ll be caught and re-​thrown as a ServiceException; oth­er­wise call_method returns the result. It’s up to the caller to deter­mine what, if any­thing, 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 men­tioned at the begin­ning. The test class method starts by build­ing a fil­tered list of all subs begin­ning with _test_ in the cur­rent class, much like methods did above with WebService::FOAAS. I then loop through that list of subs, run­ning each as a subtest con­tain­ing a class method with any excep­tions report­ed as diag­nos­tics.

The rest of the mod­uli­no is sub­test meth­ods, start­ing with a sim­ple _test_can san­i­ty check for the pub­lic meth­ods in the class. Following that is _test_methods, which starts by mocking the WebService::FOAAS pack­age and telling Test2::Mock I want to track any added, over­rid­den, or set subs. I then loop through all the method names returned by the methods class method, overrideing each one to return a sim­ple true val­ue. I then test pass­ing those names to call_method and use the hash ref­er­ence returned by sub_tracking to check that the over­rid­den sub was called. This seems a lot sim­pler than the Test::Builder-based mock­ing libraries I’ve tried like Test::MockModule and Test::MockObject.

_test_service_failure acts in much the same way, check­ing that call_method cor­rect­ly throws ServiceExceptions if the wrapped WebService::FOAAS func­tion dies. The main dif­fer­ence is that the mocked WebService::FOAAS subs are now over­rid­den with a code ref­er­ence (sub { die 'mocked' }), which call_method uses to pop­u­late the rethrown ServiceExceptions error field.

Wrapping up

With luck, this arti­cle has giv­en you some ideas, whether it’s in mak­ing scripts (per­haps lega­cy code) testable to improve them, or writ­ing bet­ter unit tests that mock depen­den­cies, or delv­ing a lit­tle into metapro­gram­ming so you can dynam­i­cal­ly sup­port and test new fea­tures of said depen­den­cies. I hope you haven’t come away too offend­ed, at least. Let me know in the com­ments what you think.