Apply lazy_required when inheriting from existing attributes

Changes

@@ -1,6 +1,8 @@
 Change history for distribution MooseX-LazyRequire
 
 {{$NEXT}}
+  - Let people specify lazy_required when inheriting attributes (Sam Kington).
+    This is RT#76054.
 
 0.11      2014-08-16 20:49:14Z
   - lots of cleanup of metadata

lib/MooseX/LazyRequire.pm

@@ -33,6 +33,16 @@ use namespace::autoclean;
     Foo->new(bar => 42); # succeeds, bar will be 42
     Foo->new;            # fails, neither foo nor bare were given
 
+    package Foo::Nevermind;
+
+    use Moose;
+    use MooseX::LazyRequire;
+    extends 'Foo';
+
+    has '+foo' => ( lazy_required => 0 );
+
+    Foo::Nevermind->new;    # succeeds
+
 =head1 DESCRIPTION
 
 This module adds a C<lazy_required> option to Moose attribute declarations.
@@ -41,6 +51,14 @@ The reader methods for all attributes with that option will throw an exception
 unless a value for the attributes was provided earlier by a constructor
 parameter or through a writer method.
 
+You can override an attribute declaration in a parent class, either enabling
+or disabling lazy-required. Note, though, that because lazy_required works by
+declaring a default value that's evaluated lazily, if you say "never mind, this
+attribute isn't lazy-required any more", you I<still> need to provide a
+default value or coderef. B<Especially> if C<undef> isn't a valid value for
+your attribute, because that's what MooseX::LazyRequire will try to enforce
+in the absence of any better guidance.
+
 =head1 CAVEATS
 
 Prior to Moose 1.9900, roles didn't have an attribute metaclass, so this module can't

lib/MooseX/LazyRequire/Meta/Attribute/Trait/LazyRequire.pm

@@ -13,6 +13,9 @@ has lazy_required => (
     default  => 0,
 );
 
+# This will be called when a new attribute is created - i.e. when someone in
+# a Moose class says has attribute => ... for the first time.
+
 after _process_options => sub {
     my ($class, $name, $options) = @_;
 
@@ -23,6 +26,12 @@ after _process_options => sub {
 
     return unless $options->{lazy_required};
 
+    $class->_enable_lazy_required($name, $options);
+};
+
+sub _enable_lazy_required {
+    my ($class, $name, $options) = @_;
+
     # lazy_required + default or builder doesn't make sense because if there
     # is a default/builder, the reader will always be able to return a value.
     Moose->throw_error(
@@ -37,6 +46,32 @@ after _process_options => sub {
     };
 };
 
+# This will be called when someone says, in a subclass of a Moose class,
+# has '+attribute' => ...
+
+around clone_and_inherit_options => sub {
+    my ($orig, $self, %options) = @_;
+
+    if ($options{lazy_required}) {
+        $self->_enable_lazy_required($self->name, \%options);
+    } elsif (exists $options{lazy_required}) {
+        # Disable lazy and required, unless we were told "actually, I like
+        # that part of lazy-required".
+        for my $boolean_option (qw(lazy required)) {
+            if (!exists $options{$boolean_option}) {
+                $options{$boolean_option} = 0;
+            }
+        }
+        # In desperation, if we haven't specified an alternative default
+        # value or coderef, claim that undef is fine. This may well not be,
+        # if the type of the attribute doesn't accept undef as a legal value.
+        if (!exists $options{default}) {
+            $options{default} = undef;
+        }
+    }
+    $self->$orig(%options);
+};
+
 package # hide
     Moose::Meta::Attribute::Custom::Trait::LazyRequire;
 

t/basic.t

@@ -3,6 +3,21 @@ use warnings;
 use Test::More 0.88;
 use Test::Fatal;
 
+{
+    package Vanilla;
+    use Moose;
+
+    has flavour => ( is => 'ro' );
+}
+
+{
+    my $vanilla   = Vanilla->new;
+    my $attribute = $vanilla->meta->find_attribute_by_name('flavour');
+    ok(!$attribute->can('lazy_required'),
+        q{If MooseX::LazyRequired isn't loaded, lazy_required isn't a method}
+    );
+}
+
 {
     package Foo;
     use Moose;
@@ -12,6 +27,8 @@ use Test::Fatal;
         is            => 'ro',
         lazy_required => 1,
     );
+
+    has other_attribute => (is => 'ro');
 }
 
 {
@@ -26,6 +43,20 @@ use Test::Fatal;
         qr/Attribute 'bar' must be provided/,
         'lazy_required value was not provided',
     );
+
+    my $foo = Foo->new;
+    my $attribute = $foo->meta->find_attribute_by_name('bar');
+    ok($attribute->can('lazy_required'),
+        'MooseX::LazyRequire is loaded, so we have a lazy_required method'
+    );
+    ok($attribute->lazy_required, 'This attribute is indeed lazy-required');
+
+    my $other_attribute = $foo->meta->find_attribute_by_name('other_attribute');
+    ok($other_attribute->can('lazy_required'),
+        'The other attribute therefore also has a lazy_required method');
+    ok(!$other_attribute->lazy_required,
+        q{The other attribute isn't lazy-required, though},
+    );
 }
 
 {

t/rt76054_inheritance.t

@@ -4,9 +4,10 @@ use warnings;
 use Test::More 0.88;
 use Test::Fatal;
 
-local $TODO = 'RT#75054';
-
+my $default_description = 'Clearly nothing that you care about';
 {
+    # Our base class has an attribute that's nothing special, and another one
+    # that most of these tests will ignore.
     package Account;
     use Moose;
     use MooseX::LazyRequire;
@@ -15,31 +16,148 @@ local $TODO = 'RT#75054';
         is  => 'rw',
         isa => 'Str',
     );
+    has description => (
+        is      => 'rw',
+        isa     => 'Str',
+        lazy    => 1,
+        default => sub { $default_description }
+    );
 
+    # The extended class wants you to specify a password, eventually.
     package AccountExt;
 
     use Moose;
     extends 'Account';
     use MooseX::LazyRequire;
-    use Carp;
 
     has '+password' => (
         is            => 'ro',
-        # Probably there also should be:
-        # traits => ['LazyRequire'],
-        # but I'm not sure
         lazy_required => 1,
     );
 
+    # A further subclass insists that you supply the password immediately.
+    package AccountExt::Harsh;
+
+    use Moose;
+    extends 'AccountExt';
+    use MooseX::LazyRequire;
+
+    has '+password' => (
+        is            => 'ro',
+        lazy_required => 0,
+        required      => 1,
+    );
+
+    # Another subclass makes the attribute lazy.
+    package AccountExt::Lazy;
+
+    use Moose;
+    extends 'AccountExt';
+    use MooseX::LazyRequire;
+
+    $AccountExt::Lazy::default_password = 'password';
+    has '+password' => (
+        lazy_required => 0,
+        lazy          => 1,
+        default       => sub { $AccountExt::Lazy::default_password },
+    );
+
+    # Another subclass will supply one for you if you don't specify one.
+    package AccountExt::Lax::Default;
+
+    use Moose;
+    extends 'AccountExt';
+    use MooseX::LazyRequire;
+
+    has '+password' => (
+        lazy_required => 0,
+        default       => sub { 'hunter2' },
+    );
+
+    # But if you don't override the default, you're SOL.
+    package AccountExt::Lax::Woo;
+
+    use Moose;
+    extends 'AccountExt';
+    use MooseX::LazyRequire;
+
+    has '+password' => (lazy_required => 0);
+
+    # If you don't mention lazy_required *at all* when overriding an
+    # attribute, that's fine.
+    package Account::Logged;
+
+    use Moose;
+    extends 'Account';
+    use MooseX::LazyRequire;
+
+    has 'description_history' => (
+        is      => 'rw',
+        isa     => 'ArrayRef',
+        default => sub { [] },
+    );
+    has '+description' => (
+        trigger => sub {
+            my ($self, $new_value, $old_value) = @_;
+            push @{ $self->description_history }, $new_value;
+        }
+    );
 }
-my $r = AccountExt->new;
 
-my $e = exception { $r->password };
-isnt($e, undef, 'works on inherited attributes') &&
-like(
-    exception { $r->password },
+# In the extension class, asking about a password generates an exception,
+# when you ask about it.
+my $account_ext = AccountExt->new;
+my $exception_ext_password = exception { $account_ext->password };
+isnt($exception_ext_password, undef,
+    'works on inherited attributes: exception')
+&& like(
+    $exception_ext_password,
     qr/Attribute 'password' must be provided before calling reader/,
-    'works on inherited attributes'
+    'works on inherited attributes: mentions password by name'
 );
+my $attribute_ext = $account_ext->meta->find_attribute_by_name('password');
+ok($attribute_ext->lazy_required,
+    'The inherited attribute is now lazy-required');
+
+# These subclasses turn lazy_required *off* again, sometimes adding in elements
+# that lazy_required provides.
+# The lax subclass is happy to provide you with a default password.
+my $account_ext_lax_default = AccountExt::Lax::Default->new;
+is($account_ext_lax_default->password,
+    'hunter2',
+    'We can override LazyRequired *off* as well');
+
+# The harsh subclass generates an exception as soon as you don't provide a
+# password.
+my $exception_harsh_constructor = exception { AccountExt::Harsh->new };
+isnt($exception_harsh_constructor, undef,
+    'Cannot create a harsh object without a password');
+
+# The lazy subclass will use a lazily-generated value.
+my $lazy = AccountExt::Lazy->new;
+{
+    local $AccountExt::Lazy::default_password = 'qwerty';
+    is($lazy->password, 'qwerty',
+        'The lazy object resolves its default value as late as possible'
+    );
+}
+
+# The woo subclass really wants to be the base subclass, but can't, because
+# a default option got in the way in the inheritance hierarchy.
+my $exception_ext_woo_password = exception { AccountExt::Lax::Woo->new };
+like(
+    $exception_ext_woo_password,
+    qr/Attribute .+ password .+ \Qdoes not pass the type constraint\E/x,
+    'Falling back to undef as a last resort violates type constraints'
+);
+
+# We don't mess with attributes in classes that use MooseX::LazyRequire but
+# don't set lazy_require explicitly, not even when subclassing attributes.
+my $logged = Account::Logged->new;
+is($logged->description, $default_description,
+    'When lazy_required is omitted entirely, the default etc. is unaffected');
+$logged->description('Now for something else');
+is($logged->description_history->[0], 'Now for something else',
+    'The trigger fired, though, so we *did* change that attribute');
 
 done_testing;