Tag: OOP

  • Scraping the Dragon with Perl and Mojolicious

    Scraping the Dragon with Perl and Mojolicious

    Every extend­ed Labor Day week­end, 80,000 fans of pop cul­ture descend on Atlanta for Dragon Con. It’s a sprawl­ing choose-​your-​own adven­ture of a con­ven­tion with 38 pro­gram­ming tracks and over 5,000 hours of events. It spans five down­town host hotels, and there is no way to see it all.

    Sadly, this year’s con is almost over. Still, I thought I’d share a lit­tle script I wrote to help me make sense of it all.

    The offi­cial mobile app is fine for search­ing and book­mark­ing events, speak­ers, and exhibitors. Nonetheless, it’s not suit­able for scan­ning the whole land­scape at once. I want­ed a sin­gle, scrol­lable view of every event, before I even packed my cosplay.

    Even in the app’s tablet ver­sion, the Dragon Con Events area is a scroll-fest.

    The web ver­sion of the app gave me exact­ly what I need­ed: pre­dictable per-​day URLs and seman­ti­cal­ly marked-​up HTML. That meant I can skip the API hunt, skip the man­u­al scrolling, and go straight to scraping.

    Inspecting the HTML reveals per-​day event URLs and per-​event <div> blocks.

    From Chaos to Clarity in 40 lines

    We’re about to turn a messy, multi-​day, multi-​hotel sched­ule into one clean, scroll-​once list. This is the forty-​five-​line Perl map that gets us there, aid­ed by the Mojolicious web toolkit.

    Laying the Groundwork: Tools for the Job

    #!/usr/bin/env perl
    
    use v5.40;
    
    use Carp;
    use English;
    use Mojo::UserAgent;
    use Mojo::URL;
    use Mojo::DOM;
    use Mojo::Collection q(c);
    use Time::Piece;
    use HTML::HTML5::Entities;
    use Memoize;
    
    binmode STDOUT, ':encoding(UTF-8)'
      or croak "Couldn't encode STDOUT: $OS_ERROR";
    
    my $ua   = Mojo::UserAgent->new();
    my $site = Mojo::URL->new('https://app.core-apps.com');
    my $path = '/dragoncon25/events/view_by_day';

    What’s hap­pen­ing: Load the mod­ules that will do the heavy lifting–HTTP fetch­es, DOM pars­ing, date han­dling, Unicode cleanup. Lock STDOUT to UTF8 so char­ac­ters like curly quotes and em-​dashes don’t break the out­put. Point the script at the base sched­ule URL.

    Remembering the Days Without Re-Parsing

    my $date_from_dom = memoize( sub ($dom) {
      return content_at( $dom, 'div.section_header[class~="alt"]' );
    } );

    What’s hap­pen­ing: Create a mem­o­ized helper that plucks the date from a day’s HTML and caches it. That way, if we need it again, we skip the DOM re-​parse and keep the pipeline fast.

    content_at is a helper func­tion I define later.

    Starting Where the App Starts

    my $today_dom = Mojo::DOM->new( $ua->get("$site$path")->result->text );

    What’s hap­pen­ing: Fetch the today” view–the same default the app shows. This is so we have a known start­ing point for build­ing the full timeline.

    Collecting the Whole Timeline

    my $day_doms = c(
      $today_dom,
      $today_dom->find(qq(div.filter_box-days > a[href^="$path?day="]))
        ->map( \&dom_from_anchor )
        ->to_array->@*,
    )->sort( sub { day_epoch($a) <=> day_epoch($b) } );

    What’s hap­pen­ing: Grab every day link from the fil­ter bar, fetch each day’s HTML, and sort them chrono­log­i­cal­ly. Now we’ve got the entire con’s sched­ule in mem­o­ry, ready to process.

    dom_from_anchor and day_epoch are two more helper func­tions explained fur­ther down.

    Turning HTML into a Human-​Readable Schedule

    $day_doms->each( sub {    # process each day's events
      my $date = $date_from_dom->($_);
    
      $_->find('a.bookmark[data-type="events"] + a.object_link')
        ->each( sub {         # output start time + title
    
          my $time    = content_at( $_, 'div.line[class~="two"]' );
          my $title   = content_at( $_, 'div.line[class~="one"]' );
          my ($start) = split /\s*\p{Dash_Punctuation}/, $time;
    
          say "$date $start: ", decode_entities($title);
        } );
    } );

    What’s hap­pen­ing: For each day, find every event link and pull out the start time and title. Split the time clean­ly on any dash and decode HTML enti­ties so the out­put reads like a real schedule.

    The Little Routines That Make It All Work

    sub dom_from_anchor ($dom) {    # fetch DOM for a day link
      return Mojo::DOM->new(
        $ua->get( Mojo::URL->new( $dom->attr('href') )->to_abs($site) )
          ->result->text );
    }
    
    sub day_epoch ($dom) {    # parse date into epoch
      return Time::Piece->strptime( $date_from_dom->($dom), '%A, %b %e' )
        ->epoch;
    }
    
    # extract and trim text from selector
    sub content_at ( $dom, @args ) { return trim $dom->at(@args)->content }

    What’s hap­pen­ing:

    1. dom_from_anchor: fetch and pars­es a linked days’ HTML.
    2. day_epoch: turn a date string into a sort-​able epoch.
    3. content_at: extract and trim text from a DOM frag­ment, giv­en a CSS selector.

    These helpers keep the main flow read­able and re-usable.

    The Schedule, Unlocked

    Run the script and you get a clean, UTF-​8-​safe list of every event, in chrono­log­i­cal order, across all days. No swip­ing around, no tap­ping, no what did I miss?” anx­i­ety. (Ha, who am I kid­ding? There’s too much going on at Dragon Con to not end up miss­ing something.)

    An exam­ple run of the script in my ter­mi­nal. Each line is Day, Date Time: Event Title”, sort­ed chrono­log­i­cal­ly across the whole con.

    And here’s just a small slice of the 2,500+ lines it produces:

    Sunday, Aug 31 11:30 AM: Unmasking Sherlock: Beyond the Many Faces
    Sunday, Aug 31 11:30 AM: Weaponization of the FCC and Other Agencies to Chill Speech
    Sunday, Aug 31 11:30 AM: Where Physics Gets Weird
    . . .
    Sunday, Aug 31 11:50 AM: Photo Session: Amelia Tyler
    Sunday, Aug 31 11:50 AM: Photo Session: Cissy Jones
    Sunday, Aug 31 11:50 AM: Photo Session: Emma Gregory
    . . .
    Sunday, Aug 31 12:00 PM: Dragon Con Mashups
    Sunday, Aug 31 12:00 PM: James J. Butcher and R.R. Virdi signing at The Missing Volume booth# 1300
    Sunday, Aug 31 12:00 PM: JoeDan Worley and Eric Dontigney signing at the Shadow Alley Press Booth# 2
    . . .
    Sunday, Aug 31 12:00 PM: Photo Session: Robert Duncan McNeill
    Sunday, Aug 31 12:00 PM: Photo Session: Robert Picardo
    Sunday, Aug 31 12:00 PM: Photo Session: Tamara Taylor

    Key Techniques

    Here’s the fun part–the tech­niques that make this tidy, scroll-​once list possible.

    CSS selectors for precision

    I used a.bookmark[data-type="events" + a.object_link] to grab only the event title links, and div.line[class~="two" /​div.line[class~="one"] for time and title, respec­tive­ly. This avoids scrap­ing unre­lat­ed elements.

    Memoization for efficiency

    memoize caches the date string for each day’s DOM so I did­n’t end up re-​parsing the HTML frag­ment mul­ti­ple times.

    Unicode-​safe splitting

    \p{Dash_Punctuation} match­es any dash type (em, en, hyphen-​minus, etc.), so I could split times reli­ably with­out wor­ry­ing about which dash the site uses.

    Functional chaining

    Mojo::Collections map, sort, and each meth­ods let me express the scrape→transform→output pipeline in a lin­ear, read­able way.

    Entity decoding at output

    HTML::HTML5::Entitiesdecode_entities is applied right before print­ing, so HTML enti­ties like &amp; or &quot; are human-​readable in the final output.

    A Pattern You Can Take Anywhere

    The same approach that tamed Dragon Con’s chaos works any­where you’ve got:

    • Predictable URLs–so you can iter­ate with­out guesswork
    • Consistent HTML structure–so your selec­tors stay stable
    • A need to see every­thing at once–so you can make deci­sions with­out pag­ing or filtering

    From fan con­ven­tions to con­fer­ence sched­ules, from local sports fix­tures to film fes­ti­val line‑ups–the same pat­tern applies. Sometimes the right tool isn’t a sprawl­ing frame­work or heavy­weight API client. It’s a forty‑odd‑line Perl script that does one thing with ruth­less clarity.

    Because once you’ve tamed a sched­ule like this, the only lines you’ll stand in are the ones that feel like part of the show.

  • 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::Usages 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­tures 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 givens 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-20161238 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.)