Tag: roles

  • Sweeter Perl exception classes

    Sweeter Perl exception classes

    What about My::Favorite::Module?

    I men­tioned at the Ephemeral Miniconflast 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::Classthan the denizens of the Libera Chat IRC #perl chan­nelinsist­ed I should use Throwableinstead 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 itover 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 rolesinstead 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­noscript 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 useit and pass a listof 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 exceptionfunc­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 exceptionfunc­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_caseas 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_hashmethod 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 throwfor re-​throwing exceptions. 

    So where does this leave last week’s FOAAS.commod­uli­no client demon­stra­tion of object mock­ingtests? 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 reviewfor 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 exceptioncalls in a BEGINblock 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 usestate­ment since the implied requirewould look for a cor­re­spond­ing file or entry in %INC. (You can get around this by mess­ing with %INCdirect­ly or through a mod­ule like me::inlinedthat does that mess­ing for you, but for a single-​purpose mod­uli­no like this it’s fine.)


  • 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…

    baseand parent

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

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

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

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

    use parent 'Local::MyParentClass';

    A cou­ple of years ago my Newfold Digitalcol­league David Oswaldcre­at­ed a fork of par­ent called parent::versionedthat 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­temson CPANthat pro­vide syn­tac­tic sug­arand extra fea­tures to Perl’s min­i­mal but flex­i­ble basics. Two of the more pop­u­lar ones, Mooseand Moo, offer an extendskey­word that you should use instead of use parentso 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::NonMoosemod­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::Padmod­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 weekabout con­sid­er­ing a more self-​consistent syntax.

    Multiple inheritancevs. 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::Roleuses 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 rolekey­word, and both class­es and roles use doesto 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 caveatabout 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 SUPERpseudo-​classto Moose’s overrideand superkey­words, to Moose’sand Moo’smethod 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­ingand mod­i­fy­ing meth­odsbefore, and when it comes to Moose and Moo code I’m now on the side of using the aroundmethod mod­i­fi­erif 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 SUPERin their methods with an :overrideattribute 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­temwill 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 Mooseobject 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­esthat, among oth­er things, map Perl meth­odsto 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­sumedby 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­pleand 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’ withstate­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_methoddoc­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 Rolsky​’s MooseX::ClassAttributemod­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 => undefto 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 Mooas a light­weight alter­na­tive to Moose, I could have instead select­ed Toby Inkster​’s 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.

  • 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 overridefunc­tionto, well, over­ride a superclass’s method. Chris Pratheron the #moose IRC chan­nelsug­gest­ed soon after that the aroundmethod mod­i­fi­er(or its lit­tle sis­ters beforeand 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 overrideonly works if you’re sub­class­ing, aroundwill 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, overridesim­ply doesn’t work: only a method mod­i­fi­er will do. (And as Graham Knopand Karen Etheridgelat­er remarked on IRC, overrideisn’t even an option if you’re using Mooas an alter­na­tive to Moose.)

    Modifying a role’s method with aroundmight 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 ($origabove) and the instance ($selfabove) 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 beforeor after:

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

    Note that there’s no return val­ue in a beforeor aftermod­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­enceto 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­sionto select meth­ods. (Beware if you’re using Moo that its Class::Method::Modifiersmod­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.