Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Why does changing a Moose attributes' properties remove the around modifier

by mcrose (Beadle)
on Jul 18, 2011 at 15:03 UTC ( [id://915199]=perlquestion: print w/replies, xml ) Need Help??

mcrose has asked for the wisdom of the Perl Monks concerning the following question:

Why does the following code not work for the derived class? Changing the properties of the base class' accessor removes the around modifier defined in the base class. When I simply inherit the base class without modifying it, however, the around modifier fires off properly.

I know I can work around this, but I'm surprised it doesn't work as-is.

use strict; use warnings; use 5.010; package My::Base; use Moose; has 'attr' => (is => 'rw', isa => 'Str', required => 1); around 'attr' => sub { my $orig = shift; my $self = shift; my $response = $self->$orig(@_); return "The value of attr is '$response'" }; package My::Derived; use Moose; extends 'My::Base'; has '+attr' => (required => 0, lazy_build => 1); sub _build_attr { return "default value"; } package My::Inherited; use Moose; extends 'My::Base'; package main; use Test::More tests => 9; use Test::Exception; throws_ok {My::Base->new()} qr/Attribute \(attr\) is required/, q/base + requires 'attr' at construction/; my $base = new_ok('My::Base' => [attr => 'constructor value']); cmp_ok($base->attr, 'eq', "The value of attr is 'constructor value'", +'base is correct'); lives_ok {My::Derived->new()} q/derived doesn't require 'attr' at cons +truction/; my $der = new_ok('My::Derived'); cmp_ok($der->attr, 'eq', "The value of attr is 'default value'", 'deri +ved is correct'); throws_ok {My::Base->new()} qr/Attribute \(attr\) is required/, q/inhe +rited requires 'attr' at construction/; my $inh = new_ok('My::Inherited' => [attr => 'constructor value']); cmp_ok($inh->attr, 'eq', "The value of attr is 'constructor value'", ' +inherited is correct');
The above gives the following output:
1..9 ok 1 - base requires 'attr' at construction ok 2 - The object isa My::Base ok 3 - base is correct ok 4 - derived doesn't require 'attr' at construction ok 5 - The object isa My::Derived not ok 6 - derived is correct # Failed test 'derived is correct' # at foobar.pl line 43. # got: 'default value' # expected: 'The value of attr is 'default value'' ok 7 - inherited requires 'attr' at construction ok 8 - The object isa My::Inherited ok 9 - inherited is correct # Looks like you failed 1 test of 9.

Replies are listed 'Best First'.
Re: Why does changing a Moose attributes' properties remove the around modifier
by stvn (Monsignor) on Jul 18, 2011 at 18:47 UTC
    Changing the properties of the base class' accessor removes the around modifier defined in the base class. When I simply inherit the base class without modifying it, however, the around modifier fires off properly.

    Actually, it is not removing the 'around' modifier, you are simply creating a new accessor in your derived class, which itself is not around-ed. Allow me to explain ...

    When you create an attribute, Moose compiles the accessor methods for you and installs them in the package in which they are defined. These accessor methods are nothing magical (in fact, nothing in Moose is very magical, complex yes, but magical no), and so they are inherited by subclasses just as any other method would be.

    When you "around" a method (as you are doing here) Moose will extract the sub from the package, wrap it and replace the original with the wrapped version. This all happens in the local package only, the method modifiers do not know (or care) anything about inheritance.

    When you change an attributes definition using the +attr form, Moose looks up the attribute meta-object in the superclass list and then clones that attribute meta-object, applying the changes you requested and then installs that attributes into the local class. The result is that all accessor methods are re-compiled into the local class, therefore overriding the ones defined in the superclass.

    Make sense?

    -stvn

      It does; and I figured something like that was what was going on. I'm just surprised that the metaobject protocol doesn't account for inherited wrapper methods when figuring out a derived class' accessor code. Is there any way to direct Moose to continue using the superclass's around modifier, or is this intended to be the correct way of modifying an accessor's result when expecting inheritance that modifies the metaobject?

      use strict; use warnings; use 5.010; package My::Base; use Moose; has 'attr' => (is => 'ro', isa => 'Str', required => 1, reader => '_at +tr'); sub attr { my $self = shift; return "The value of attr is '".$self->_attr."'" }; package My::Derived; use Moose; extends 'My::Base'; has '+attr' => (required => 0, lazy_build => 1); sub _build_attr { return "default value"; } package main; use Test::More tests => 6; use Test::Exception; throws_ok {My::Base->new()} qr/Attribute \(attr\) is required/, q/base + requires 'attr' at construction/; my $base = new_ok('My::Base' => [attr => 'constructor value']); cmp_ok($base->attr, 'eq', "The value of attr is 'constructor value'", +'base is correct'); lives_ok {My::Derived->new()} q/derived doesn't require 'attr' at cons +truction/; my $der = new_ok('My::Derived'); cmp_ok($der->attr, 'eq', "The value of attr is 'default value'", 'deri +ved is correct');

        I stated a lot of that badly, but after reflection, no it makes total sense that the original code doesn't work as-is, and that it needs to be gotten around by creating a shim subroutine that gets inherited down the object hierarchy that runs against the Moose-built accessor. You can disregard the question.

        It would, however, be pretty nice if Moose could support this sort of behavior natively and have it just work, instead of requiring that sort of workaround. Not conversant in the nuts and bolts of the Class::MOP internals, however, I'm not sure if such a thing is possible.

Re: Why does changing a Moose attributes' properties remove the around modifier
by Khen1950fx (Canon) on Jul 18, 2011 at 18:02 UTC
    I couldn't replicate your error. I kept getting "around":
    use Modern::Perl; package My::Base; use Moose; has 'attr' => (is => 'rw', isa => 'Str', required => 1); around 'attr' => sub { my $orig = shift; my $self = shift; say "I get around..."; return $self->$orig() unless @_; }; package My::Derived; use Moose; extends 'My::Base'; has '+attr' => (required => 0, lazy_build => 1); sub _build_attr { return "default value"; } package My::Inherited; use Moose; extends 'My::Base'; package main; use Test::More; use Test::Exception; use Test::More::Diagnostic; plan tests => 8; my $base = new_ok('My::Base' => [attr => 'constructor value']); cmp_ok($base->attr, 'eq', "constructor value", 'base is correct'); lives_ok {My::Derived->new()} q/derived doesn't require 'attr' at cons +truction/; my $der = new_ok('My::Derived'); cmp_ok($der->attr, 'eq', 'default value', 'derived is correct'); throws_ok {My::Base->new()} qr/Attribute \(attr\) is required/, q/inhe +rited requires 'attr' at construction/;

      What perl & moose versions?. I'm getting the same thing (no around in the derived class) under both perl 5.10.0 linux and 5.12.3 win32; both with Moose 2.0010:

      TAP version 13 1..8 ok 1 - The object isa My::Base I get around... ok 2 - base is correct ok 3 - derived doesn't require 'attr' at construction ok 4 - The object isa My::Derived ok 5 - derived is correct ok 6 - inherited requires 'attr' at construction # Looks like you planned 8 tests but ran 6.

      Stop making incorrect conclusions about other's code after you modified it.

      I couldn't replicate your error.

      Except you did.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://915199]
Approved by marto
Front-paged by toolic
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (2)
As of 2024-03-19 06:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found