Tag: Test2

  • Even lighter Perl modulinos with Util::H2O::More

    Even lighter Perl modulinos with Util::H2O::More

    A few weeks ago, I wrote about how to use the mod­uli­no pat­tern in Perl to cre­ate unit-​testable com­mand line tools. Fellow Houston Perl Monger Brett Estrade point­ed me to a dif­fer­ent approach on the Perl Applications & Algorithms Discord. This approach trims boil­er­plate while keep­ing scripts testable.

    Brett’s Utils::H2O::More mod­ule amends the light­weight class builder Utils::H2O. It adds many extra meth­ods, includ­ing com­mand line argu­ment pro­cess­ing via the Perl-​packaged Getopt::Long mod­ule. It also promis­es to build its acces­sors with less cer­e­mo­ny and code than Moo.

    So let’s dive in!

    A simple script

    A script can use Util::H2O::More’s Getopt2h2o func­tion to process com­mand line options. It returns an object with acces­sors for each parameter.

    Here’s a sim­ple exam­ple, mod­eled after my ear­li­er mod­uli­no exer­cise:

    #!/usr/bin/env perl
    
    use v5.38;
    use Util::H2O::More v0.4.2 qw(Getopt2h2o);
    
    # name is a string, water is an array of strings
    my $o = Getopt2h2o \@ARGV, {}, qw(
        name=s
        water=s@
    );
    die "Missing --name\n" unless $o->name;
    
    printf "Good %s, %s!\n", time_of_day(), $o->name;
    
    if ( defined $o->water and $o->water->@* ) {
        say 'What kind of water would you like?';
        say "- $_" for $o->water->@*;
    }
    
    sub time_of_day {
        my %hours = (
             5 => 'morning',
            12 => 'afternoon',
            17 => 'evening',
            21 => 'night',
        );
    
        for ( sort { $b <=> $a } keys %hours ) {
            return $hours{$_} if (localtime)[2] >= $_;
        }
        return 'night';
    }

    This is short and read­able. I like how Getopt::Long’s quirky para­me­ter pars­ing syn­tax is repur­posed to cre­ate acces­sors, even for multi-​valued options.

    You can call this script like so:

    ./h2options.pl --name Aquarius --water hot --water cold

    We had to check that --name was set, as Util::H2O::More does­n’t sup­port using an = mod­i­fi­er to spec­i­fy required options. This is some­thing Getopt::Long allows.

    And as Util::H2O’s doc­u­men­ta­tion sug­gests: ​“You should prob­a­bly switch to some­thing like Moo instead [for advanced features].”

    But enough about limitations–what if you want­ed to use this as a Perl mod­ule for testing?

    Testing the waters

    One of the strengths of a mod­uli­no is the abil­i­ty to unit test its log­ic with­out invok­ing it from the shell. A typ­i­cal test script looks like this:

    #!/usr/bin/env perl
    
    use v5.38;
    use Test2::V0;
    use modulinh2o;
    
    plan(6);
    
    can_ok(
        'modulinh2o',
        [ 'time_of_day', 'name', 'water' ],
        'class has methods',
    );
    my $water = modulinh2o->new( name => 'Aquarius' );
    isa_ok( $water, ['modulinh2o'],
            'object is expected class' );
    can_ok(
        $water,
        [ 'time_of_day', 'name', 'water' ],
        'object has methods',
    );
    
    is( $water->name,        'Aquarius', 'name set' );
    is( $water->name('Bob'), 'Bob',      'name change' );
    is( $water->time_of_day,
        in_set( qw(
            morning
            afternoon
            evening
            night
        ) ),
        'time of day function',
    );

    It isn’t dif­fi­cult to adapt a mod­uli­no from our ear­li­er sim­ple script:

    #!/usr/bin/env perl
    
    use v5.38;
    
    package modulinh2o;
    
    use Getopt::Long qw();
    use Util::H2O::More v0.4.2 qw(h2o opt2h2o);
    
    my @opt_spec = qw(
        name=s
        water=s@
    );
    my $o = h2o -classify => __PACKAGE__, {},
            opt2h2o(@opt_spec);
    
    sub time_of_day {
        my %hours = (
             5 => 'morning',
            12 => 'afternoon',
            17 => 'evening',
            21 => 'night',
        );
    
        for ( sort { $b <=> $a } keys %hours ) {
            return $hours{$_} if (localtime)[2] >= $_;
        }
        return 'night';
    }
    
    # constructor that parses arguments w/ basic validation
    sub new_with_options ($class) {
        Getopt::Long::GetOptionsFromArray(
          \@ARGV, $o, @opt_spec
        ) or die "bad options\n";
        die "Missing --name\n" unless $o->name;
        return $o;
    }
    
    sub run ($self) {
        printf "Good %s, %s!\n",
               time_of_day(), $self->name;
    
        if ( defined $self->water and $self->water->@* ) {
            say 'What kind of water would you like?';
            say "- $_" for $self->water->@*;
        }
        return;
    }
    
    package main;
    
    main() unless caller;
    
    sub main { modulinh2o->new_with_options->run() }

    And run:

    ./modulinh2o.pm --name Aquarius \
      --water sparkling --water still

    This is much short­er than the Moo-​based mod­uli­no from three weeks ago, but it also does­n’t do as much. There’s no sup­port for using com­ma sep­a­ra­tors to pass mul­ti­ple val­ues to a sin­gle argu­ment. Worse, there’s no auto­mat­ic help text if one pass­es the wrong options.

    Both are fix­able, as we’ll see in a moment. Still, you end up hav­ing to write the POD your­self, print­ed out with var­i­ous invo­ca­tions of Pod::Usage​’s pod2usage() function.

    An ounce of script is worth a gallon of documentation

    Here’s a full exam­ple that adds both --help and --man com­mand line options, as typ­i­cal­ly pro­vid­ed by tra­di­tion­al Getopt::Long-based scripts:

    #!/usr/bin/env perl
    
    use v5.38;
    
    package modulinh2o2;
    
    use Getopt::Long qw();
    use Util::H2O::More v0.4.2 qw(h2o opt2h2o);
    use Pod::Usage;
    
    my @opt_spec = qw(
        name=s
        water=s@
    
        help
        man
    );
    my $o = h2o -classify => __PACKAGE__, {},
            opt2h2o(@opt_spec);
    
    sub time_of_day {
        my %hours = (
             5 => 'morning',
            12 => 'afternoon',
            17 => 'evening',
            21 => 'night',
        );
    
        for ( sort { $b <=> $a } keys %hours ) {
            return $hours{$_} if (localtime)[2] >= $_;
        }
        return 'night';
    }
    
    # different parameter mixes for pod2usage()
    my %pod2usage_opt = (
        cmdline => {
            -exitval  => 2,
            -verbose  => 99,
            -sections => 'USAGE/Command line',
            -message  => 'Use --help to list options',
        },
        opts => {
            -exitval  => 0,
            -verbose  => 99,
            -sections => ['USAGE/Command line', 'OPTIONS'],
        },
        man => {
            -exitval => 0,
            -verbose => 2,
        },
    );
    
    sub new_with_options ($class) {
        Getopt::Long::GetOptionsFromArray(
          \@ARGV, $o, @opt_spec
        ) or pod2usage( %pod2usage_opt{cmdline} );
    
        pod2usage( $pod2usage_opt{opts} ) if $o->help;
        pod2usage( $pod2usage_opt{man} )  if $o->man;
        pod2usage( %pod2usage_opt{cmdline},
          -message => 'Missing --name',
        ) unless $o->name;
    
        # default values for the water parameter
        $o->water(
              ( defined $o->water and $o->water->@* )
            ? [ split /,/, join q{,}, $o->water->@* ]
            : [ qw(
                still
                sparkling
                tap
            ) ] );
    
        return $o;
    }
    
    sub run ($self) {
        printf "Good %s, %s!\n",
               time_of_day(), $self->name;
    
        say 'What kind of water would you like?';
        say "- $_" for $self->water->@*;
    
        return;
    }
    
    package main;
    
    main() unless caller;
    
    sub main { modulinh2o2->new_with_options->run() }
    
    # the rest below is documentation
    
    __END__
    
    =head1 NAME
    
    modulinh2o2 - demo of a modulino using Util::H2O::More
    
    =head1 USAGE
    
    =head2 Command line
    
        modulinh2o2.pm [options]
    
    =head2 Perl
    
        use modulinh2o2;
        my $water = modulinh2o2->new(
            name  => 'Aquarius',
            water => [ qw(
                sparkling
                still
                tap
            ) ],
        );
        $water->run;
    
    =head1 OPTIONS
    
    =over
    
    =item B<--name>
    
    Your name here! (required)
    
    =item B<--water>
    
    Type of water to serve. May be specified multiple times, either by repeating the option or separated by commas.
    
    Takes an arrayref when used as a method or construction parameter.
    
    Default values:
    
    =over
    
    =item still
    
    =item sparkling
    
    =item tap
    
    =back
    
    =item B<--help>
    
    Displays a brief help message.
    
    =item B<--man>
    
    Display full documentation as a manual page.
    
    =back
    
    =head1 DESCRIPTION
    
    A sample L<Util::H2O::More> modulino that prints your name, what part of the day it is, and a menu of water choices.
    
    =head1 METHODS
    
    =head2 new
    
    Constructor that takes the above L</OPTIONS> but without the preceding C<-->.
    
    =head2 new_with_options
    
    Alternate constructor that receives its parameters from C<@ARGV>.
    
    =head2 run
    
    Prints out a greeting along with a selection of refreshing drinks.
    
    =head2 ACCESSOR OPTIONS
    
    All of the L</OPTIONS> above are also available as method accessors but without the preceding C<-->.
    
    =head1 FUNCTIONS
    
    =head2 time_of_day
    
    Returns the period of the day based on local time. Possible values are:
    
    =over
    
    =item morning
    
    =item afternoon
    
    =item evening
    
    =item night
    
    =back
    
    =head1 AUTHOR
    
    Mark Gardner <[email protected]>
    
    =head1 LICENSE AND COPYRIGHT
    
    This software is copyright (c) 2025 by Mark Gardner.
    
    This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

    Now we can run either:

    ./modulinh2o2.pm --help

    to get a quick help mes­sage, or:

    ./modulinh2o2.pm --man

    to show the full man­u­al page.

    Yes, over half of the line count is doc­u­men­ta­tion. Even grant­i­ng this the code amount is now com­pa­ra­ble to the Moo-​based ver­sion. And you don’t get the advan­tage of MooX::Options’ declar­a­tive syntax.

    To sum­ma­rize, here’s a table chart­ing the evo­lu­tion of our modulinh2o:

    StageProsConsComplexity
    Simple script:
    Getopt2h2o only
    * Minimal code foot­print
    * Instant acces­sors from CLI argu­ments
    * Multi-​valued options via @ syntax
    * No required-​argument enforce­ment
    * No auto-​help
    * Manual validation
    Low:
    about 20 lines, one file
    Basic mod­uli­no:
    h2o + opt2h2o
    * Testable as a mod­ule
    * Reusable new_with_options con­struc­tor
    * Keeps brevi­ty vs. Moo
    * Still no comma-​separated multi-​values
    * No auto-​help on bad arguments
    Medium:
    adds pack­age struc­ture, test harness
    Full mod­uli­no w/​help & man:
    Pod::Usage inte­grat­ed
    * Support for --help and --man
    * Comma-​separated multi-​values han­dled
    * Defaults for miss­ing --water
    * Clearer on-​boarding for new users
    * More boil­er­plate
    * Over half the file is POD
    * Still less declar­a­tive than MooX::Options
    High:
    more mov­ing parts, but user-friendly
    Util::H2O::More mod­uli­no evo­lu­tion and fea­ture trade-offs

    Seen togeth­er, these stages trace a course from a bare-​bones script to a well-​provisioned mod­uli­no. Each step adds fea­tures at the cost of a lit­tle more complexity.

    In the end, Util::H2O::More deliv­ers a lean, testable mod­uli­no with far less boil­er­plate than Moo–but also few­er built‑in niceties. If you val­ue speed from idea to work­ing script and can live with­out declar­a­tive option han­dling, it’s a com­pelling choice. For more struc­tured needs, MooX::Options still has the edge. Either way, the path from script to production-​ready mod­uli­no is short­er than you think.

    The best tool is the one that flows from idea to ​“it works” in a sin­gle pour.

  • Lightweight object-​oriented Perl scripts: From modulinos to moodulinos

    Lightweight object-​oriented Perl scripts: From modulinos to moodulinos

    Last week I found myself devel­op­ing a Perl script to cat­a­log some infor­ma­tion for our qual­i­ty assur­ance team. Unfortunately, as these things some­times do, the scrip­t’s com­plex­i­ty and require­ments start­ed increas­ing. I still want­ed to keep it as a sim­ple script. Yet, it was grow­ing com­mand line argu­ments that need­ed extra val­i­da­tion. I also need­ed to test some func­tions with­out wait­ing for the entire script to run.

    As with many things Perl, the basic solu­tion is fair­ly old. Over twen­ty years ago, bri­an d foy pop­u­lar­ized the mod­uli­no pat­tern. in which Perl scripts that you exe­cute from the com­mand line can also act as Perl mod­ules. You can even use these mod­ules in oth­er con­texts, for exam­ple test­ing.* A mod­uli­no seemed like the per­fect solu­tion for test­ing indi­vid­ual script func­tions, but writ­ing object-​oriented Perl out­side of a frame­work (or the new Perl class syn­tax) can be chal­leng­ing and verbose.

    Enter the cow (Moo)

    The Moo sys­tem of mod­ules are billed as a light­weight way ​“to con­cise­ly define objects and roles with a con­ve­nient syn­tax that avoids the details of Perl’s object sys­tem.” It does­n’t have any XS code. Thus, it does­n’t need a C com­pil­er to install. Unlike its inspi­ra­tion, Moose, it’s opti­mized for the fast start­up time need­ed for a command-​line script. Sure, you don’t get a full-​strength meta-​object pro­to­col for query­ing and manip­u­lat­ing class­es, objects, and attributes—those capa­bil­i­ties are con­cerns for larg­er appli­ca­tions or libraries. In keep­ing with the light­weight theme, you can use Type::Tiny con­straints for para­me­ter val­i­da­tion. Additionally, there are sev­er­al solu­tions for turn­ing command-​line argu­ments into object attrib­ut­es. (I chose to use MooX::Options, main­ly because of its easy avail­abil­i­ty as an Ubuntu Linux pack­age.)

    I’m not about to dump a pro­pri­etary script here on my blog. Yet, I have worked up an illus­tra­tive exam­ple of how to incor­po­rate Moo into a mod­uli­no. Call it a ​“mooduli­no” if you like; here’s a short-​ish script to tell Perl just how you feel at this time of day:

    #!/usr/bin/env perl
    
    use v5.38;
    
    package moodulino;
    use Moo;
    use MooX::Options;
    use Types::Standard qw(ArrayRef Str);
    
    option name => (
        is       => 'ro',
        isa      => Str,
        required => 1,
        short    => 'n',
        doc      => 'your name here',
        format   => 's',
    );
    
    option moods => (
        is        => 'ro',
        isa       => ArrayRef [Str],
        predicate => 1,
        short     => 'm',
        doc       => 'a list of how you might feel',
        format    => 's@',
        autosplit => ',',
    );
    
    has time_of_day => (
        is      => 'ro',
        isa     => Str,
        builder => 1,
    );
    
    sub _build_time_of_day ($self) {
        my %hours = (
             5 => ‘morning’,
            12 => 'afternoon',
            17 => 'evening',
            21 => 'night',
        );
    
        for ( sort { $b <=> $a } keys %hours ) {
            return $hours{$_} if (localtime)[2] >= $_;
        }
        return 'night';
    }
    
    sub run ($self) {
        printf "Good %s, %s!\n",
          $self->time_of_day,
          $self->name;
    
        if ( $self->has_moods ) {
            say 'How are you feeling?';
            say "- $_?" for $self->moods->@*;
        }
    }
    
    package main;
    
    main() unless caller;
    
    sub main { moodulino->new_with_options->run() }

    And here’s what hap­pens when I run it:

    % chmod a+x moodulino.pm
    % ./moodulino.pm
    name is missing
    USAGE: moodulino.pm [-h] [long options ...]
    
        -m --moods=[Strings]  a list of how you might feel
        -n --name=String      your name here
    
        --usage               show a short help message
        -h                    show a compact help message
        --help                show a long help message
        --man                 show the manual
    % ./moodulino.pm --name Mark
    Good afternoon, Mark!
    % ./moodulino.pm —name Mark --moods happy --moods sad --moods excited
    Good afternoon, Mark!
    How are you feeling?
    - happy?
    - sad?
    - excited?
    % ./moodulino.pm —name Mark --moods happy,sad,excited
    Good afternoon, Mark!
    How are you feeling?
    - happy?
    - sad?
    - excited?

    If the mood strikes, I can even write a test script for my script:

    #!/usr/bin/env perl
    
    use v5.38;
    use Test2::V0;
    use moodulino;
    
    plan(3);
    
    my $mood = moodulino->new( name => 'Bessy' );
    isa_ok( $mood, 'moodulino' );
    can_ok( $mood, 'time_of_day' );
    
    is( $mood->time_of_day,
        in_set( qw(
            morning
            afternoon
            evening
            night
        ) ) );

    And run it:

    % prove -I. t/time_of_day.t
    t/daytime.t .. ok
    All tests successful.
    Files=1, Tests=3,  0 wallclock secs ( 0.00 usr  0.00 sys +  0.07 cusr  0.01 csys =  0.08 CPU)
    Result: PASS

    * foy lat­er expand­ed this idea into the chap­ter ​“Modules as Programs” in Mastering Perl (2007). You can also read more in his 2014 arti­cle ​“Rescue lega­cy code with mod­uli­nos”. Also explore Gábor Szabó’s arti­cles on the top­ic. ↩︎

  • 34 at 34 for v5.34: Modern Perl features for Perl’s birthday

    34 at 34 for v5.34: Modern Perl features for Perl’s birthday

    Friday, December 17, 2021, marked the thirty-​fourth birth­day of the Perl pro­gram­ming lan­guage, and coin­ci­den­tal­ly this year saw the release of ver­sion 5.34. There are plen­ty of Perl devel­op­ers out there who haven’t kept up with recent (and not-​so-​recent) improve­ments to the lan­guage and its ecosys­tem, 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 syn­tax with­out break­ing back­ward com­pat­i­bil­i­ty. You can enable indi­vid­ual fea­tures by name (e.g., use feature qw(say fc); for the say and fc key­words), or by using a fea­ture bun­dle based on the Perl ver­sion that intro­duced them. For exam­ple, the following:

    use feature ':5.34';

    …gives you the equiv­a­lent 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 mouth­ful. Feature bun­dles are good. The cor­re­spond­ing bun­dle also gets implic­it­ly loaded if you spec­i­fy a min­i­mum required Perl ver­sion, e.g., with use v5.32;. If you use v5.12; or high­er, strict mode is enabled for free. So just say:

    use v5.34;

    And last­ly, one-​liners can use the -E switch instead of -e to enable all fea­tures for that ver­sion of Perl, so you can say the fol­low­ing on the com­mand line:

    perl -E 'say "Hello world!"'

    Instead of:

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

    Which is great when you’re try­ing to save some typing.

    The experimental pragma

    Sometimes new Perl fea­tures need to be dri­ven a cou­ple of releas­es around the block before their behav­ior set­tles. Those exper­i­ments are doc­u­ment­ed in the per­l­ex­per­i­ment page, and usu­al­ly, you need both a use feature (see above) and no warnings state­ment to safe­ly enable them. Or you can sim­ply pass a list to use experimental of the fea­tures 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 expan­sion of the -w command-​line switch to a sys­tem of fine-​grained con­trols for warn­ing against ​“dubi­ous con­structs” that can be turned on and off depend­ing on the lex­i­cal scope. What start­ed as 26 main and 20 sub­cat­e­gories has expand­ed into 31 main and 43 sub­cat­e­gories, includ­ing warn­ings for the afore­men­tioned exper­i­men­tal features.

    As the rel­e­vant Perl::Critic pol­i­cy says, ​“Using warn­ings, and pay­ing atten­tion to what they say, is prob­a­bly the sin­gle most effec­tive way to improve the qual­i­ty of your code.” If you must vio­late warn­ings (per­haps because you’re reha­bil­i­tat­ing some lega­cy code), you can iso­late such vio­la­tions to a small scope and indi­vid­ual cat­e­gories. Check out the stric­tures mod­ule on CPAN if you’d like to go fur­ther and make a safe sub­set of these cat­e­gories fatal dur­ing development.

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

    Not every new bit of Perl syn­tax is enabled with a feature guard. For the rest, there’s E. Choroba’s Syntax::Construct mod­ule on CPAN. Rather than hav­ing to remem­ber which ver­sion of Perl intro­duced what, Syntax::Construct lets you declare only what you use and pro­vides a help­ful error mes­sage if some­one tries to run your code on an old­er unsup­port­ed ver­sion. Between it and the feature prag­ma, you can pre­vent 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 func­tions only return false on fail­ure, requir­ing the devel­op­er to check every time whether a file can be opened or a system com­mand exe­cut­ed. The lex­i­cal autodie prag­ma replaces them with ver­sions that raise an excep­tion with an object that can be inter­ro­gat­ed for fur­ther details. No mat­ter how many func­tions or meth­ods deep a prob­lem occurs, you can choose to catch it and respond appro­pri­ate­ly. This leads us to…

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

    This year’s Perl v5.34 release intro­duced exper­i­men­tal try/​catch syn­tax for excep­tion han­dling that should look more famil­iar to users of oth­er lan­guages while han­dling the issues sur­round­ing using block eval and test­ing of the spe­cial $@ vari­able. If you need to remain com­pat­i­ble with old­er ver­sions of Perl (back to v5.14), just use the Feature::Compat::Try mod­ule from CPAN to auto­mat­i­cal­ly select either v5.34’s native try/​catch or a sub­set of the func­tion­al­i­ty pro­vid­ed by Syntax::Keyword::Try.

    Pluggable keywords

    The above­men­tioned Syntax::Keyword::Try was made pos­si­ble by the intro­duc­tion of a plug­gable key­word mech­a­nism in 2010’s Perl v5.12. So was the Future::AsyncAwait asyn­chro­nous pro­gram­ming library and the Object::Pad test­bed for new object-​oriented Perl syn­tax. If you’re handy with C and Perl’s XS glue lan­guage, check out Paul ​“LeoNerd” Evans’ XS::Parse::Keyword mod­ule to get a leg up on devel­op­ing your own syn­tax module.

    Define packages with versions and blocks

    Perl v5.12 also helped reduce clut­ter by enabling a package name­space dec­la­ra­tion to also include a ver­sion num­ber, instead of requir­ing a sep­a­rate our $VERSION = ...; v5.14 fur­ther refined packages to be spec­i­fied in code blocks, so a name­space dec­la­ra­tion can be the same as a lex­i­cal scope. Putting the two togeth­er 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 old­er instal­la­tions 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 assign­ing defaults to variables.

    state variables only initialize once

    Speaking of vari­ables, ever want one to keep its old val­ue the next time a scope is entered, like in a sub? Declare it with state instead of my. Before Perl v5.10, you need­ed to use a clo­sure instead.

    Save some typing with say

    Perl v5.10’s bumper crop of enhance­ments also includ­ed the say func­tion, which han­dles the com­mon use case of printing a string or list of strings with a new­line. It’s less noise in your code and saves you four char­ac­ters. What’s not to love?

    Note unimplemented code with ...

    The ... ellip­sis state­ment (col­lo­qui­al­ly ​“yada-​yada”) gives you an easy place­hold­er for yet-​to-​be-​implemented code. It pars­es OK but will throw an excep­tion if exe­cut­ed. Hopefully, your test cov­er­age (or at least sta­t­ic analy­sis) will catch it before your users do.

    Loop and enumerate arrays with each, keys, and values

    The each, keys, and values func­tions have always been able to oper­ate on hash­es. Perl v5.12 and above make them work on arrays, too. The lat­ter two are main­ly for con­sis­ten­cy, but you can use each to iter­ate over an array’s indices and val­ues at the same time:

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

    This can be prob­lem­at­ic in non-​trivial loops, but I’ve found it help­ful in quick scripts and one-liners.

    delete local hash (and array) entries

    Ever need­ed to delete an entry from a hash (e.g, an envi­ron­ment vari­able from %ENV or a sig­nal han­dler from %SIG) just inside a block? Perl v5.12 lets you do that with delete local.

    Paired hash slices

    Jumping for­ward to 2014’s Perl v5.20, the new %foo{'bar', 'baz'} syn­tax enables you to slice a sub­set of a hash with its keys and val­ues intact. Very help­ful for cherry-​picking or aggre­gat­ing many hash­es 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 return­ing 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 intro­duced and v5.24 de-​experimentalized a more read­able post­fix deref­er­enc­ing syn­tax for nav­i­gat­ing nest­ed data struc­tures. Instead of using {braces} or smoosh­ing sig­ils to the left of iden­ti­fiers, you can use a post­fixed 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 devel­op­ment is sling­ing around and pick­ing apart com­pli­cat­ed data struc­tures via JSON, so I wel­come any­thing like this to reduce the cog­ni­tive load.

    when as a statement modifier

    Starting in Perl v5.12, you can use the exper­i­men­tal switch fea­ture​’s when key­word as a post­fix mod­i­fi­er. For example:

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

    But I don’t rec­om­mend when, given, or given​’s smart­match oper­a­tions as they were ret­conned as exper­i­ments in 2013’s Perl v5.18 and have remained so due to their tricky behav­ior. I wrote about some alter­na­tives using sta­ble syn­tax back in February.

    Simple class inheritance with use parent

    Sometimes in old­er object-​oriented Perl code, you’ll see use base as a prag­ma to estab­lish inher­i­tance from anoth­er class. Older still is the direct manip­u­la­tion of the package’s spe­cial @ISA array. In most cas­es, both should be avoid­ed in favor of use parent, which was added to core in Perl v5.10.1.

    Mind you, if you’re fol­low­ing the Perl object-​oriented tutorial’s advice and have select­ed an OO sys­tem from CPAN, use its sub­class­ing mech­a­nism if it has one. Moose, Moo, and Class::Accessor’s ​“antlers” mode all pro­vide an extends func­tion; Object::Pad pro­vides an :isa attribute on its class key­word.

    Test for class membership with the isa operator

    As an alter­na­tive to the isa() method pro­vid­ed to all Perl objects, Perl v5.32 intro­duced the exper­i­men­tal isa infix oper­a­tor:

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

    The lat­ter can take either a bare­word class name or string expres­sion, but more impor­tant­ly, it’s safer as it also returns false if the left argu­ment is unde­fined or isn’t a blessed object ref­er­ence. The old­er isa() method will throw an excep­tion in the for­mer case and might return true if called as a class method when $my_object is actu­al­ly a string of a class name that’s the same as or inher­its from isa()​’s argu­ment.

    Lexical subroutines

    Introduced in Perl v5.18 and de-​experimentalized in 2017’s Perl v5.26, you can now pre­cede sub dec­la­ra­tions with my, state, or our. One use of the first two is tru­ly pri­vate func­tions and meth­ods, as described in this 2018 Dave Jacoby blog and as part of Neil Bowers’ 2014 sur­vey of pri­vate func­tion techniques.

    Subroutine signatures

    I’ve writ­ten and pre­sent­ed exten­sive­ly about sig­na­tures and alter­na­tives over the past year, so I won’t repeat that here. I’ll just add that the Perl 5 Porters devel­op­ment mail­ing list has been mak­ing a con­cert­ed effort over the past month to hash out the remain­ing issues towards ren­der­ing this fea­ture non-​experimental. The pop­u­lar Mojolicious real-​time web frame­work also pro­vides a short­cut for enabling sig­na­tures and uses them exten­sive­ly in examples.

    Indented here-​documents with <<~

    Perl has had shell-​style ​“here-​document” syn­tax for embed­ding multi-​line strings of quot­ed text for a long time. Starting with Perl v5.26, you can pre­cede the delim­it­ing string with a ~ char­ac­ter and Perl will both allow the end­ing delim­iter to be indent­ed as well as strip inden­ta­tion from the embed­ded text. This allows for much more read­able embed­ded 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 teach­ers and text­books would often describe mul­ti­ple com­par­isons and inequal­i­ties as a sin­gle expres­sion. Unfortunately, when it came time to learn pro­gram­ming every com­put­er lan­guage I saw required them to be bro­ken up with a series of and (or &&) oper­a­tors. With Perl v5.32, this is no more:

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

    It’s more con­cise, less noisy, and more like what reg­u­lar math looks like.

    Self-​documenting named regular expression captures

    Perl’s expres­sive reg­u­lar expres­sion match­ing and text-​processing prowess are leg­endary, although overuse and poor use of read­abil­i­ty enhance­ments often turn peo­ple away from them (and Perl in gen­er­al). We often use reg­ex­ps for extract­ing data from a matched pat­tern. For example:

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

    Named cap­ture groups, intro­duced in Perl v5.10, make both the pat­tern more obvi­ous 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 reg­u­lar expres­sion mod­i­fi­er already enables bet­ter read­abil­i­ty by telling the pars­er to ignore most white­space, allow­ing you to break up com­pli­cat­ed pat­terns into spaced-​out groups and mul­ti­ple lines with code com­ments. With Perl v5.26 you can spec­i­fy /xx to also ignore spaces and tabs inside [brack­et­ed] char­ac­ter class­es, turn­ing 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, writ­ing use re '/xms'; (or any com­bi­na­tion of reg­u­lar expres­sion mod­i­fi­er flags) will turn on those flags until the end of that lex­i­cal scope, sav­ing you the trou­ble of remem­ber­ing them every time.

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

    The s/// sub­sti­tu­tion and tr/// translit­er­a­tion oper­a­tors typ­i­cal­ly change their input direct­ly, often in con­junc­tion with the =~ bind­ing oper­a­tor:

    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 orig­i­nal untouched, such as when pro­cess­ing an array of strings with a map? With Perl v5.14 and above, add the /r flag, which makes the sub­sti­tu­tion 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 char­ac­ter encod­ing in gen­er­al are com­pli­cat­ed beasts. Perl has han­dled Unicode since v5.6 and has kept pace with fix­es and sup­port for updat­ed stan­dards in the inter­ven­ing decades. If you need to test if two strings are equal regard­less of case, use the fc func­tion intro­duced in Perl v5.16.

    Safer processing of file arguments with <<>>

    The <> null file­han­dle or ​“dia­mond oper­a­tor” is often used in while loops to process input per line com­ing either from stan­dard input (e.g., piped from anoth­er pro­gram) or from a list of files on the com­mand line. Unfortunately, it uses a form of Perl’s open func­tion that inter­prets spe­cial char­ac­ters such as pipes (|) that would allow it to inse­cure­ly run exter­nal com­mands. Using the <<>> ​“dou­ble dia­mond” oper­a­tor intro­duced in Perl v5.22 forces open to treat all command-​line argu­ments as file names only. For old­er Perls, the per­lop doc­u­men­ta­tion rec­om­mends the ARGV::readonly CPAN mod­ule.

    Safer loading of Perl libraries and modules from @INC

    Perl v5.26 removed the abil­i­ty for all pro­grams to load mod­ules by default from the cur­rent direc­to­ry, clos­ing a secu­ri­ty vul­ner­a­bil­i­ty orig­i­nal­ly iden­ti­fied and fixed as CVE-2016–1238 in pre­vi­ous ver­sions’ includ­ed scripts. If your code relied on this unsafe behav­ior, the v5.26 release notes include steps on how to adapt.

    HTTP::Tiny simple HTTP/1.1 client included

    To boot­strap access to CPAN on the web in the pos­si­ble absence of exter­nal tools like curl or wget, Perl v5.14 began includ­ing the HTTP::Tiny mod­ule. You can also use it in your pro­grams if you need a sim­ple web client with no dependencies.

    Test2: The next generation of Perl testing frameworks

    Forked and refac­tored from the ven­er­a­ble Test::Builder (the basis for the Test::More library that many are famil­iar with), Test2 was includ­ed in the core mod­ule library begin­ning with Perl v5.26. I’ve exper­i­ment­ed recent­ly with using the Test2::Suite CPAN library instead of Test::More and it looks pret­ty good. I’m also intrigued by Test2::Harness’ sup­port for thread­ing, fork­ing, and pre­load­ing mod­ules to reduce test run times.

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

    This last item may not be includ­ed when you install Perl, but it’s where I turn for a col­lec­tion of well-​regarded CPAN mod­ules for accom­plish­ing a wide vari­ety of com­mon tasks span­ning from asyn­chro­nous pro­gram­ming to XML. Use it as a start­ing point or inter­ac­tive­ly select the mix of libraries appro­pri­ate to your project.


    And there you have it: a selec­tion of 34 fea­tures, enhance­ments, and improve­ments for the first 34 years of Perl. What’s your favorite? Did I miss any­thing? Let me know in the comments.

  • Sweeter Perl exception classes

    Sweeter Perl exception classes

    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.)


  • Vicious (test) mockery of a Perl modulino

    Vicious (test) mockery of a Perl modulino

    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 foy​’s 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 ServiceException​’s 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.