Tag: OOP

  • 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 foys mod­uli­no con­cept from Mastering Perl (sec­ond edi­tion, 2014) that mar­ries script and mod­ule into a self-​contained exe­cutable library.

    #!/usr/bin/env perl
    
    package Local::CallFOAAS;  # this is a modulino
    use Test2::V0;             # enables strict, warnings, utf8
    
    # declare all the new stuff we're using
    use feature qw(say state);
    use experimental qw(isa postderef signatures);
    use Feature::Compat::Try;
    use Syntax::Construct qw(non-destructive-substitution);
    
    use WebService::FOAAS ();
    use Package::Stash;
    use Exception::Class (
        NoMethodException => {
            alias  => 'throw_no_method',
            fields => 'method',
        },
        ServiceException => { alias => 'throw_service' },
    );
    
    my $foaas = Package::Stash->new('WebService::FOAAS');
    
    my $run_as =
        !!$ENV{CPANTEST}       ? 'test'
      : !defined scalar caller ? 'run'
      :                          undef;
    __PACKAGE__->$run_as(@ARGV) if defined $run_as;
    
    sub run ( $class, @args ) {
        try { say $class->call_method(@args) }
        catch ($e) {
            die 'No method ', $e->method, "\n"
              if $e isa NoMethodException;
            die 'Service error: ', $e->error, "\n"
              if $e isa ServiceException;
            die "$e\n";
        }
        return;
    }
    
    # Utilities
    
    sub methods ($) {
        state @methods = sort map s/^foaas_(.+)/$1/r,
          grep /^foaas_/, $foaas->list_all_symbols('CODE');
        return @methods;
    }
    
    sub call_method ( $class, $method = '', @args ) {
        state %methods = map { $_ => 1 } $class->methods();
        throw_no_method( method => $method )
          unless $methods{$method};
        return do {
            try { $foaas->get_symbol("&$method")->(@args) }
            catch ($e) { throw_service( error => $e ) }
        };
    }
    
    # Testing
    
    sub test ( $class, @ ) {
        state $stash = Package::Stash->new($class);
        state @tests = sort grep /^_test_/,
          $stash->list_all_symbols('CODE');
    
        for my $test (@tests) {
            subtest $test => sub {
                try { $class->$test() }
                catch ($e) { diag $e }
            };
        }
        done_testing();
        return;
    }
    
    sub _test_can ($class) {
        state @subs = qw(run call_method methods test);
        can_ok( $class, \@subs, "can do: @subs" );
        return;
    }
    
    sub _test_methods ($class) {
        my $mock = mock 'WebService::FOAAS' => ( track => 1 );
    
        for my $method ( $class->methods() ) {
            $mock->override( $method => 1 );
    
            ok lives { $class->call_method($method) },
              "$method lives";
            ok scalar $mock->sub_tracking->{$method}->@*,
              "$method called";
        }
        return;
    }
    
    sub _test_service_failure ($class) {
        my $mock = mock 'WebService::FOAAS';
    
        for my $method ( $class->methods() ) {
            $mock->override( $method => sub { die 'mocked' } );
    
            my $exception =
              dies { $class->call_method($method) };
            isa_ok $exception, ['ServiceException'],
              "$method throws ServiceException on failure";
            like $exception->error, qr/^mocked/,
              "correct error in $method exception";
        }
        return;
    }
    
    1;

    Let’s walk through the code above.

    Preliminaries

    First, there’s a gener­ic she­bang line to indi­cate that Unix and Linux sys­tems should use the perl exe­cutable found in the user’s PATH via the env com­mand. I declare a pack­age name (in the Local:: name­space) so as not to pol­lute the default main pack­age of oth­er scripts that might want to require this as a mod­ule. Then I use the Test2::V0 bun­dle from Test2::Suite since the embed­ded test­ing code uses many of its func­tions. This also has the side effect of enabling the strict, warn­ings, and utf8 prag­mas, so there’s no need to explic­it­ly use them here.

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

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

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

    The next block deter­mines how, if at all, I’m going to run the code as a script. If the CPANTEST envi­ron­ment vari­able is set, I’ll call the test class method sub, but if there’s no sub­rou­tine call­ing me I’ll exe­cute the run class method. Either will receive the com­mand line argu­ments from @ARGV. If nei­ther of these con­di­tions is true, do noth­ing; the rest of the code is method declarations.

    Modulino methods, metaprogramming, and exceptions

    The first of these is the run method. It’s a thin wrap­per around the call_method class method detailed below, either out­putting its result or dieing with an appro­pri­ate error depend­ing on the class of excep­tion thrown. Although I chose not to write tests for this out­put, future tests might call this method and catch these rethrown excep­tions to match against them. The mes­sages end with a \n new­line char­ac­ter so die knows not to append the cur­rent script line number.

    Next is a util­i­ty method called methods that uses Package::Stash’s list_all_symbols to retrieve the names of all named CODE blocks (i.e., subs) from WebService::FOAAS’s sym­bol table. Reading from right to left, these are then fil­tered with grep to only find those begin­ning in foaas_ and then trans­formed with map to remove that pre­fix. The list is then sorted and stored in a state vari­able and returned so it need not be ini­tial­ized again.

    (As an aside, although perlcritic stern­ly warns against it I’ve cho­sen the expres­sion forms of grep and map here over their block forms for sim­plic­i­ty’s sake. It’s OK to bend the rules if you have a good reason.)

    sub call_method is where the real action takes place. Its para­me­ters are the class that called it, the name of a FOAAS $method (default­ed to the emp­ty string), and an array of option­al argu­ments in @args. I build a hash or asso­cia­tive array from the ear­li­er methods method which I then use to see if the passed method name is one I know about. If not, I throw a NoMethodException using the throw_no_method alias func­tion cre­at­ed when I used Exception::Class at the begin­ning. Using a func­tion instead of NoMethodException->throw() means that it’s checked at com­pile time rather than run­time, catch­ing typos.

    I get the sub­rou­tine (denot­ed by a & sig­il) named by $method from the $foaas stash and pass it any fur­ther received argu­ments from @args. If that WebService::FOAAS sub­rou­tine throws an excep­tion it’ll be caught and re-​thrown as a ServiceException; oth­er­wise call_method returns the result. It’s up to the caller to deter­mine what, if any­thing, to do with that result or any thrown exceptions.

    Testing the modulino with mocks

    This is where I start using those Test2::Suite tools I men­tioned at the begin­ning. The test class method starts by build­ing a fil­tered list of all subs begin­ning with _test_ in the cur­rent class, much like methods did above with WebService::FOAAS. I then loop through that list of subs, run­ning each as a subtest con­tain­ing a class method with any excep­tions report­ed as diag­nos­tics.

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

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

    Wrapping up

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

  • Multiple ways to inheritance in Perl

    Multiple ways to inheritance in Perl

    Inspired by my par­ents com­ing to vis­it at the end of the week, I thought I’d write about how Perl class­es can have par­ents” as well, from which they inher­it meth­ods. Although it might seem on the sur­face as though there’s more than one way to do it, these tech­niques all share the same under­ly­ing mechanism.

    Where it all BEGINs: @ISA

    Perl class­es are just repur­posed packages, i.e., a name­space for vari­ables and sub­rou­tines. The two key dif­fer­ences are:

    If you want­ed to do every­thing by hand at the low­est lev­el, you could make a sub­class at com­pile time like this:

    package Local::MyChildClass;
    BEGIN { # don't do this:
        require Local::MyParentClass;
        push @ISA, 'Local::MyParentClass';
    }

    Don’t do that though, because we have…

    base and parent

    In 1997 Perl 5.004_04 intro­duced the base prag­ma (back when Perl used that kind of ver­sion­ing scheme; in these days of seman­tic ver­sion­ing we’d call it ver­sion 5.4.4). It does the above BEGIN block in a sin­gle line:

    use base 'Local::MyParentClass'; # don't do this unless you're also using fields

    You might see use base in old­er code espe­cial­ly if it’s also using the fields prag­ma. However, Perl devel­op­ers dis­cour­age both as the for­mer silences cer­tain mod­ule load­ing errors while the lat­ter is at odds with the object-​oriented pro­gram­ming prin­ci­ple of encap­su­la­tion.

    So use parent instead, which Perl has includ­ed since ver­sion 5.10.1 in 2009:

    use parent 'Local::MyParentClass';

    A cou­ple of years ago my Newfold Digital col­league David Oswald cre­at­ed a fork of par­ent called parent::versioned that sup­ports spec­i­fy­ing the low­est ver­sion for super­class­es. You call it like this:

    use parent::versioned ['Local::MyParentClass' => 1.23];

    Within an OO system

    There are dozens of object-​oriented pro­gram­ming sys­tems on CPAN that pro­vide syn­tac­tic sug­ar and extra fea­tures to Perl’s min­i­mal but flex­i­ble basics. Two of the more pop­u­lar ones, Moose and Moo, offer an extends key­word that you should use instead of use parent so that your sub­class­es may take advan­tage of their features:

    package Local::MyChildClass;
    use Moo;
    extends 'Local::MyParentClass';

    Moose can also spec­i­fy a required super­class version:

    package Local::MyChildClass;
    use Moose;
    extends 'Local::MyParentClass' => {-version => 1.23};

    Also, use the MooseX::NonMoose mod­ule when extend­ing non-​Moose class­es, again so you get Moose fea­tures even though your meth­ods are com­ing from some­where else:

    package Local::MyMooseClass;
    use Moose;
    use MooseX::NonMoose;
    extends 'Local::MyPlainParentClass';

    The exper­i­men­tal Object::Pad mod­ule spec­i­fies a sin­gle super­class while defin­ing the class name with an option­al ver­sion. Per the author’s sug­gest­ed file lay­out, includ­ing a required min­i­mum ver­sion, it would look like:

    use Object::Pad 0.41;
    package Local::MyChildClass;
    class Local::MyChildClass isa Local::MyParentClass 1.23;

    Object::Pad and Corinna, its inspi­ra­tion, are works in progress so this syn­tax isn’t set in stone. The latter’s design­er Curtis Ovid” Poe blogged ear­li­er this week about con­sid­er­ing a more self-​consistent syntax.

    Multiple inheritance vs. roles

    To quote the Perl doc­u­men­ta­tion, mul­ti­ple inher­i­tance often indi­cates a design prob­lem, but Perl always gives you enough rope to hang your­self with if you ask for it.” All the tech­niques described above except for Object::Pad sup­port mul­ti­ple inher­i­tance by spec­i­fy­ing a list of super­class­es. For example:

    package Local::MyChildClass;
    use parent qw(Local::MyParentClass1 Local::MyParentClass2);

    If you’re using roles instead of or on top of super­class­es (I’ve seen both sit­u­a­tions) and your OO sys­tem doesn’t sup­port them on its own, you can use the Role::Tiny mod­ule, first by describ­ing your role in one pack­age and then con­sum­ing it in another:

    package Local::DoesSomething;
    use Role::Tiny;
    
    ...
    
    1;
    package Local::MyConsumer;
    use Role::Tiny::With;
    with 'Local::DoesSomething';
    
    ...
    
    1;

    Moo::Role uses Role::Tiny under the hood and Moo can com­pose roles from either. The syn­tax for both Moo and Moose is similar:

    package Local::DoesSomething;
    use Moo::Role; # or "use Moose::Role;"
    
    ...
    
    1;
    package Local::MyConsumer;
    use Moo; # or "use Moose;"
    with 'Local::DoesSomething';
    
    ...
    
    1;

    Object::Pad spec­i­fies roles with the role key­word, and both class­es and roles use does to con­sume them:

    use Object::Pad 0.56;
    package Local::DoesSomething;
    role Local::DoesSomething does Local::DoesSomethingElse;
    
    ...
    
    1;
    use Object::Pad 0.56;
    package Local::MyConsumer;
    class Local::MyConsumer does Local::DoesSomething;
    
    ...
    
    1;

    The pre­vi­ous caveat about pos­si­ble changes to this syn­tax applies.

    Like parent, (sort of) like child

    Of course, the whole point of inher­i­tance or role con­sump­tion is so your child or con­sumer class can reuse func­tions and meth­ods. Each of the tech­niques above has its ways of over­rid­ing that code, from the Perl built-​in SUPER pseudo-​class to Moose’s override and super key­words, to Moose’s and Moo’s method mod­i­fiers. (You can use the lat­ter out­side of Moo since it’s pro­vid­ed by Class::Method::Modifiers.)

    I’ve writ­ten about choos­ing between over­rid­ing and mod­i­fy­ing meth­ods before, and when it comes to Moose and Moo code I’m now on the side of using the around method mod­i­fi­er if a method needs to call an inher­it­ed or con­sumed method of the same name. Object::Pad doesn’t have method mod­i­fiers (yet), so classes that use it will have to sat­is­fy them­selves with SUPER in their methods with an :override attribute that will throw an error if a par­ent doesn’t also pro­vide the same method.

    The Parent Wrap

    In the end, your choice of Perl OO sys­tem will deter­mine how (or whether) you han­dle inher­i­tance and may even be a decid­ing fac­tor. Which would you choose? And more impor­tant­ly, have I made my par­ents proud with this post?

  • Taming the Moose: Classing up Perl attributes

    Taming the Moose: Classing up Perl attributes

    At my work, we exten­sive­ly use the Moose object sys­tem to take care of what would ordi­nar­i­ly be very tedious boil­er­plate object-​oriented Perl code. In one part of the code­base, we have a fam­i­ly of class­es that, among oth­er things, map Perl meth­ods to the names of var­i­ous calls in a third-​party API with­in our larg­er orga­ni­za­tion. Those pri­vate Perl meth­ods are in turn called from pub­lic meth­ods pro­vid­ed by roles con­sumed by these class­es so that oth­er areas aren’t con­cerned with said API’s details.

    Without going into too many specifics, I had a bunch of class­es all with sec­tions that looked like this:

    sub _create_method    { return 'api_add'     }
    sub _retrieve_method  { return 'api_info'    }
    sub _search_method    { return 'api_list'    }
    sub _update_method    { return 'api_update'  }
    sub _cancel_method    { return 'api_remove'  }
    sub _suspend_method   { return 'api_disable' }
    sub _unsuspend_method { return 'api_restore' }
    
    ... # etc.

    The val­ues returned by these very sim­ple meth­ods might dif­fer from class to class depend­ing on the API call need­ed, and dif­fer­ent class­es might have a dif­fer­ent mix of these meth­ods depend­ing on what roles they consume.

    These meth­ods had built up over time as devel­op­ers had expand­ed the class­es’ func­tion­al­i­ty, and this week it was my turn. I decid­ed to apply the DRY (don’t repeat your­self) prin­ci­ple and cre­ate them from a sim­ple hash table like so:

    my %METHOD_MAP = (
      _create_method    => 'api_add',
      _retrieve_method  => 'api_info',
      _search_method    => 'api_list',
      _update_method    => 'api_update',
      _cancel_method    => 'api_remove',
      _suspend_method   => 'api_disable',
      _unsuspend_method => 'api_restore',
    );

    At first, I thought to myself, These look like pri­vate read-​only attrib­ut­es!” So I wrote:

    use Moose;
    
    ...
    
    has $_ => (
      is       => 'ro',
      init_arg => undef,
      default  => $METHOD_MAP{$_},
    ) for keys %METHOD_MAP;

    Of course, I’d have to move the class­es’ with state­ments after these def­i­n­i­tions so the roles they con­sume could see” these runtime-​defined attrib­ut­es. But some of the meth­ods used to read these are class meth­ods (e.g., called as ClassName->foo() rather than $object->foo()), and Moose attrib­ut­es are only set after the con­struc­tion of a class instance.

    Then I thought, Hey, Moose has a MOP (meta-​object pro­to­col)! I’ll use that to gen­er­ate these meth­ods at runtime!”

    my $meta = __PACKAGE__->meta;
    
    while (my ($method, $api_call) = each %METHOD_MAP) {
        $meta->add_method( $method => sub {$api_call} );
    }

    The add_method doc­u­men­ta­tion strong­ly encourage[s]” you to pass a metamethod object rather than a code ref­er­ence, though, so that would look like:

    use Moose::Meta::Method;
    
    my $meta = __PACKAGE__->meta;
    
    while (my ($method, $api_call) = each %METHOD_MAP) {
        $meta->add_method( $method = Moose::Meta::Method->wrap(
          sub {$api_call}, __PACKAGE__, $meta,
        );
    }

    This was get­ting ugly. There had to be a bet­ter way, and for­tu­nate­ly there was in the form of Dave Rolskys MooseX::ClassAttribute mod­ule. It sim­pli­fies the above to:

    use MooseX::ClassAttribute;
    
    class_has $_ => (
      is      => 'ro',
      default => $METHOD_MAP{$_},
    ) for keys %METHOD_MAP;

    Note there’s no need for init_arg => undef to pre­vent set­ting the attribute in the con­struc­tor. Although they’re still Moose attrib­ut­es, they act like class meth­ods so long as the class con­sumes the roles that require them after the attribute definitions.

    Lastly, if we were using Moo as a light­weight alter­na­tive to Moose, I could have instead select­ed Toby Inksters MooX::ClassAttribute. Although it has some caveats, it’s pret­ty much the only alter­na­tive to our ini­tial class method def­i­n­i­tions as Moo lacks a meta-​object pro­to­col.

    The les­son as always is to check CPAN (or the appro­pri­ate mix of your language’s soft­ware repos­i­to­ry, forums like Stack Overflow, etc.) for any­thing that could con­ceiv­ably have appli­ca­tion out­side of your par­tic­u­lar cir­cum­stances. Twenty-​five years into my career and I’m still leap­ing into code with­out first con­sid­er­ing that some­one smarter than me has already done the work.

  • Cutting the fat: Lightweight Perl OO modules

    Cutting the fat: Lightweight Perl OO modules

    This blog has devot­ed a fair amount of atten­tion to the pop­u­lar and mul­ti­fac­eted object-​oriented sys­tem Moose and its light­weight sub­set Moo. I’ve also cov­ered Object::Pad, the test­bed of con­cepts and syn­tax for Corinna, the pro­posed next-​generation Perl core OO sys­tem. But what if your project is too memory‑, performance‑, or dependency-​constrained for these options?

    It turns out that CPAN has a rich his­to­ry of lighter-​weight OO mod­ules to meet many dif­fer­ent needs. If you can live with their trade-​offs, they’re worth inves­ti­gat­ing instead of rolling your own lay­er over Perl’s OO. Here are a few.

    Class::Struct

    Class::Structs main claim to fame is its inclu­sion in the stan­dard Perl dis­tri­b­u­tion, so there’s no need to install depen­den­cies from CPAN. It pro­vides a syn­tax for defin­ing class­es as C‑style structs at either com­pile time or run­time. (There’s no speed advan­tage to the for­mer; it just means that your class will be built as if you had writ­ten the acces­sors your­self as subs.) Here’s an example:

    #!/usr/bin/env perl
    
    use v5.24; # for strict, say, and postfix dereferencing
    use warnings;
    
    package Local::MyClass;
    use Class::Struct (
        foo => '$',
        bar => '@',
        baz => '%',
    );
    
    package main;
    
    my $obj = Local::MyClass->new(
        foo => 'hello',
        bar => [1, 2, 3],
        baz => { name => 'Mark'},
    );
    
    say $obj->foo, ' ', $obj->baz('name');
    say join ',', $obj->bar->@*;
    
    # replace the name element of baz
    $obj->baz(name => 'Sharon');
    
    # replace the second element of bar
    $obj->bar(1, 'replaced');
    say $obj->foo, ' ', $obj->baz('name');
    say join ',', $obj->bar->@*;

    And here’s the output:

    hello Mark
    1,2,3
    hello Sharon
    1,replaced,3

    Note that Class::Struct sup­ports acces­sors for scalar, array, and hash types, as well as oth­er class­es (not demon­strat­ed). Consult the module’s doc­u­men­ta­tion for the dif­fer­ent ways to define and retrieve them.

    Class::Accessor

    Class::Accessor does one thing: it makes acces­sors and muta­tors (also known as get­ters and set­ters) for fields in your class. Okay, it actu­al­ly does anoth­er thing: it pro­vides your class with a new method to ini­tial­ize those fields. Those acces­sors can be read-​write, read-​only, or write-​only. (Why would you want write-​only acces­sors?) You can define any of them using either its his­tor­i­cal class meth­ods or a Moose-​like attribute syn­tax.

    If you’re try­ing to squeeze every bit of per­for­mance out of your code and can sac­ri­fice a lit­tle flex­i­bil­i­ty in alter­ing acces­sor behav­ior, you can opt for Class::Accessor::Fast or Class::Accessor::Faster. The for­mer still uses hash ref­er­ences under the hood to rep­re­sent objects and the lat­ter uses array ref­er­ences. The main Class::Accessor doc­u­men­ta­tion con­tains an effi­cien­cy com­par­i­son of the three for your edification.

    Here’s an exam­ple script using Class::Accessor::Faster and the Moose-​like syntax:

    #!/usr/bin/env perl
    
    use v5.12; # for strict and say
    use warnings;
    
    package Local::MyClass;
    use Class::Accessor::Faster 'moose-like';
    
    has readwrite => (is => 'rw');
    has readonly  => (is => 'ro');
    
    package main;
    
    my $obj = Local::MyClass->new( { # must be a hash reference
        readwrite => 'hello',
        readonly  => 'world',
    } );
    
    say $obj->readwrite, ' ', $obj->readonly;
    $obj->readwrite('greetings');
    say $obj->readwrite, ' ', $obj->readonly;
    
    # throws an error
    $obj->readonly('Cleveland');

    And here is its output:

    hello world
    greetings world
    'main' cannot alter the value of 'readonly' on objects of class 'Local::MyClass' at ./caf.pl line 24.

    Class::Tiny

    Class::Tiny both does less and more than Class::Accessor. All of its gen­er­at­ed acces­sors are read-​write, but you can also give their attrib­ut­es lazy defaults. Its gen­er­at­ed con­struc­tor takes argu­ments via either a Class::Accessor-style hash ref­er­ence or a plain list of key/​value pairs, so that’s a lit­tle more con­ve­nient. It also sup­ports Moose-​style BUILDARGS, BUILD, and DEMOLISH meth­ods for argu­ment adjust­ment, val­i­da­tion, and object cleanup, respectively.

    It’s a toss-​up as to which of the pre­vi­ous two is bet­ter.” You’ll have to exam­ine their respec­tive fea­tures and deter­mine which ones map to your needs.

    Here’s an exam­ple script that shows a few of Class::Tiny’s unique features:

    #!/usr/bin/env perl
    
    use v5.12; # for strict and say
    use warnings;
    
    package Local::MyClass;
    use Class::Tiny qw<foo bar>,
    {
        baz       => 'default baz',
        timestamp => sub { time },
    };
    
    package main;
    
    my $obj = Local::MyClass->new( # plain key-values OK
        foo => 'hello',
        bar => 'world',
    );
    
    say $obj->foo, ' ', $obj->bar;
    say 'Object built on ', scalar localtime $obj->timestamp;
    $obj->foo('greetings');
    $obj->bar('Cleveland');
    say $obj->foo, ' ', $obj->bar;
    say $obj->baz;

    And its output:

    hello world
    Object built on Tue Sep  7 09:00:00 2021
    greetings Cleveland
    default baz

    Object::Tiny

    For an even more min­i­mal­ist approach, con­sid­er Object::Tiny. Its acces­sors are read-​only, it gives you a sim­ple con­struc­tor, and that’s it. Its doc­u­men­ta­tion lists a num­ber of rea­sons why it can be supe­ri­or to Class::Accessor, includ­ing low­er mem­o­ry usage and less typ­ing. There’s also a fork called Object::Tiny::RW that adds read-​write sup­port to its accessors.

    Class::Tiny’s doc­u­men­ta­tion con­tains a fea­ture table com­par­i­son of it, Object::Tiny, and Class::Accessor. This may help you decide which to use.

    Here’s an exam­ple script:

    #!/usr/bin/env perl
    
    use v5.12; # for strict and say
    use warnings;
    
    package Local::MyClass;
    use Object::Tiny qw<foo bar>;
    
    package main;
    
    my $obj = Local::MyClass->new(
        foo => 'hello',
        bar => 'world',
    );
    
    say $obj->foo, ' ', $obj->bar;
    
    # has no effect unless you use Object::Tiny::RW
    $obj->foo('greetings');
    say $obj->foo, ' ', $obj->bar;

    And its output:

    hello world
    hello world

    Add some speed with XS

    If the above options are still too slow and you don’t mind requir­ing a C com­pil­er to install them, there are vari­ants that use Perl’s XS inter­face instead of pure Perl code:

    Roles with Role::Tiny

    If you’re eye­ing Moose and Moo’s sup­port for roles (also known as traits) as an alter­na­tive to inher­i­tance but still want to keep things light with one of the above mod­ules, you’re in luck. The Role::Tiny mod­ule lets you com­pose meth­ods into con­sum­ing class­es with Moo-​like syn­tax and will pull in Common Lisp Object System-style method mod­i­fi­er sup­port from Class::Method::Modifiers if you need it. It does mean anoth­er cou­ple of CPAN depen­den­cies, so if that’s a prob­lem in your sit­u­a­tion you’ll just have to live with­out roles.

    Here’s an exam­ple script with a role and a con­sum­ing class that uses Class::Tiny. The role requires that its con­sumers imple­ment a required_method, pro­vides a foo method that uses it, and a method mod­i­fi­er for bar.

    #!/usr/bin/env perl
    
    use v5.12; # for strict and say
    use warnings;
    
    package Local::MyRole;
    use Role::Tiny;
    
    requires 'required_method';
    
    sub foo {
        my $self = shift;
        say $self->required_method();
    }
    
    before bar => sub {
        warn 'About to call bar...';
    };
    
    package Local::MyClass;
    use Class::Tiny {name => ''};
    use Role::Tiny::With;
    with 'Local::MyRole';
    
    sub bar {
        my ($self, $greeting) = @_;
        say "$greeting ", $self->name;
    }
    
    sub required_method {
        my $self = shift;
        return 'Required by Local::MyRole';
    }
    
    package main;
    
    my $obj = Local::MyClass->new(name => 'Mark');
    $obj->bar('hello');
    
    $obj->name('Sharon');
    $obj->bar('salutations');
    
    $obj->foo();

    And its output:

    About to call bar... at ./rt.pl line 17.
    hello Mark
    About to call bar... at ./rt.pl line 17.
    salutations Sharon
    Required by Local::MyRole

    What’s your favorite?

    There will always be those who insist on writ­ing every­thing long­hand, but mod­ules like these can save a lot of time and typ­ing as well as reduce errors. Do you have a favorite, maybe some­thing I missed? Let me know in the comments.

  • Taming the Moose: Method modifiers instead of overrides in object-​oriented Perl

    Taming the Moose: Method modifiers instead of overrides in object-​oriented Perl

    Last month I wrote about using Moose’s override func­tion to, well, over­ride a superclass’s method. Chris Prather on the #moose IRC chan­nel sug­gest­ed soon after that the around method mod­i­fi­er (or its lit­tle sis­ters before and after) might be a bet­ter choice if you’re also call­ing the orig­i­nal method inside. He not­ed that at a min­i­mum override only works if you’re sub­class­ing, around will apply to com­posed meth­ods too.”

    His point was that when you decide to com­pose roles (also know as traits) instead of or in addi­tion to more tra­di­tion­al inher­i­tance, override sim­ply doesn’t work: only a method mod­i­fi­er will do. (And as Graham Knop and Karen Etheridge lat­er remarked on IRC, override isn’t even an option if you’re using Moo as an alter­na­tive to Moose.)

    Modifying a role’s method with around might look like this:

    #!/usr/bin/env perl

    use v5.12; # for strict and say
    use warnings;

    package Local::Role::Hungry;
    use Moose::Role;
    requires 'name';

    sub wants_food {
    my $self = shift;
    say $self->name, ' is hungry!';
    return;
    }

    package Local::GuineaPig;
    use Moose;
    has name => (is => 'ro');
    with 'Local::Role::Hungry';

    around wants_food => sub {
    my ($orig, $self, @args) = @_;
    say $self->name, ' runs to the front of the cage!';
    $self->$orig(@args);
    say 'Wheek!';
    return;
    };

    package Local::Dog;
    use Moose;
    has name => (is => 'ro');
    with 'Local::Role::Hungry';

    around wants_food => sub {
    my ($orig, $self, @args) = @_;
    say $self->name, ' runs to the kitchen!';
    $self->$orig(@args);
    say 'Woof!';
    return;
    };

    before wants_food => sub {
    my $self = shift;
    say $self->name, ' is jumping!';
    };

    package main;
    my $dog = Local::Dog->new(name => 'Seamus');
    my @pigs = map { Local::GuineaPig->new(name => $_) }
    qw<Cocoa Ginger Pepper>;

    for my $animal ($dog, @pigs) {
    $animal->wants_food();
    }

    Running the above yields:

    Seamus runs to the kitchen!
    Seamus is hungry!
    Woof!
    Cocoa runs to the front of the cage!
    Cocoa is hungry!
    Wheek!
    Ginger runs to the front of the cage!
    Ginger is hungry!
    Wheek!
    Pepper runs to the front of the cage!
    Pepper is hungry!
    Wheek!

    It’s a lit­tle more involved than over­rid­ing a sub, since method mod­i­fiers are passed both the con­sumed role’s orig­i­nal method ($orig above) and the instance ($self above) as para­me­ters. It has the same effect, though, and you can call the orig­i­nal method by say­ing $self->$orig(parameters).

    If all you want to do is have some­thing hap­pen either before or after the orig­i­nal method, just use before or after:

    before wants_food => sub {
    my $self = shift;
    say $self->name, ' is jumping!';
    };

    Note that there’s no return val­ue in a before or after mod­i­fi­er, as those are han­dled by the orig­i­nal method.

    Modifiers aren’t lim­it­ed to con­sum­ing class­es; they can be in roles and mod­i­fy their con­sumers’ meth­ods. They also have a cou­ple of oth­er tricks:

    • You can pass an array ref­er­ence to mod­i­fy mul­ti­ple meth­ods at once.
    • You can use the con­tents of a vari­able to spec­i­fy the mod­i­fied method name, and use that same vari­able in the mod­i­fi­er itself.
    • You can use a reg­u­lar expres­sion to select meth­ods. (Beware if you’re using Moo that its Class::Method::Modifiers mod­ule doesn’t sup­port this.)

    Putting these togeth­er gives you con­structs like these:

    after qw<foo bar baz> => sub {
    say 'Something got called';
    };

    for my $method_name (qw<foo bar baz>) {
    before $method_name => sub {
    say "Calling $method_name...";
    };
    }

    before qr/^request_/ => sub {
    my ($self, @args) = @_;
    $self->is_valid(@args) or die 'Invalid arguments';
    };

    Moose comes with great intro­duc­to­ry man­u­als for method mod­i­fiers and roles, so be sure to check those out. There’s a lot more to them and a blog can only cov­er so much.