From 885bf88998a1f65a2430e2e3d6700c4275eefd53 Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Thu, 18 Jun 2020 23:39:14 +0100 Subject: [PATCH 1/8] Make this code slightly less clever, in anticipation of a future change. --- lib/Moose/Meta/Attribute.pm | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index d6106aaec..0c3700009 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -238,13 +238,20 @@ sub clone { my $class = delete $params{metaclass} || ref $self; - my ( @init, @non_init ); - - foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) { - push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr; + my ( %new_params, @non_init ); + + my @possible_attrs = Class::MOP::class_of($self)->get_all_attributes; + foreach my $attr ( grep { $_->has_value($self) } @possible_attrs ) { + if ($attr->has_init_arg) { + $new_params{$attr->init_arg} = $attr->get_value($self); + } else { + push @non_init, $attr; + } } - my %new_params = ( ( map { $_->init_arg => $_->get_value($self) } @init ), %params ); + for my $param_name (keys %params) { + $new_params{$param_name} = $params{$param_name}; + } my $name = delete $new_params{name}; From 8ec5ed310e21a164986c7410ec55198c8df97e56 Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Thu, 18 Jun 2020 23:55:05 +0100 Subject: [PATCH 2/8] Let people say has '+attribute_name' => ( clear_default => 1 }; This doesn't set the default to undef (i.e. if you don't set the attribute value, it's set to undef - which may violate a type constraint). Rather, it removes entirely the default value. --- lib/Moose/Meta/Attribute.pm | 14 +++++++++++++- t/attributes/attribute_inherited_slot_specs.t | 15 +++++++++++++++ 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 0c3700009..9efac707e 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -241,6 +241,7 @@ sub clone { my ( %new_params, @non_init ); my @possible_attrs = Class::MOP::class_of($self)->get_all_attributes; + my %attr_by_name = map { $_->name => $_ } @possible_attrs; foreach my $attr ( grep { $_->has_value($self) } @possible_attrs ) { if ($attr->has_init_arg) { $new_params{$attr->init_arg} = $attr->get_value($self); @@ -249,8 +250,19 @@ sub clone { } } + ### TODO: can't say default => 'foo' and clear_default => 1 + ### TODO: can't say clear_brush if brush isn't a valid attribute name + ### TODO: test that clear_attribute_name if attribute_name isn't set + ### does nothing. for my $param_name (keys %params) { - $new_params{$param_name} = $params{$param_name}; + if ($param_name =~ /^ clear_ (.+) /x) { + my $cleared_attr_name = $1; + if ($attr_by_name{$cleared_attr_name}) { + delete $new_params{$cleared_attr_name}; + } + } else { + $new_params{$param_name} = $params{$param_name}; + } } my $name = delete $new_params{name}; diff --git a/t/attributes/attribute_inherited_slot_specs.t b/t/attributes/attribute_inherited_slot_specs.t index 2556e9a3e..7e76ef7c4 100644 --- a/t/attributes/attribute_inherited_slot_specs.t +++ b/t/attributes/attribute_inherited_slot_specs.t @@ -114,6 +114,15 @@ use Test::Fatal; ::like( ::exception { has '+does_not_exist' => (isa => 'Str'); }, qr/in Bar/, '... cannot extend a non-existing attribute' ); + + package Foo::VagueBar; + use Moose; + + extends 'Foo'; + + ::is( ::exception { + has '+bar' => (clear_default => 1); + }, undef, 'Can clear a previous default'); } my $foo = Foo->new; @@ -191,6 +200,12 @@ is($bar->baz, undef, '... got the right undef default value'); isnt( exception { $bar->baz($code_ref) }, undef, '... Bar::baz does not accept a code ref' ); } +my $foo_vaguebar = Foo::VagueBar->new; +isa_ok($foo_vaguebar, 'Foo::VagueBar'); +isa_ok($foo_vaguebar, 'Foo'); +ok(!$foo_vaguebar->meta->find_attribute_by_name('bar')->has_value($foo_vaguebar), + 'An attribute whose definition gets rid of a default value does not have a value'); + # check some meta-stuff ok(Bar->meta->has_attribute('foo'), '... Bar has a foo attr'); From dd1744f384ff6981689113d0cdc496c69eb19dce Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Fri, 19 Jun 2020 00:17:00 +0100 Subject: [PATCH 3/8] Explain and document clear_default. --- lib/Moose/Manual/Attributes.pod | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/lib/Moose/Manual/Attributes.pod b/lib/Moose/Manual/Attributes.pod index e4c1a3bad..424cea3c0 100644 --- a/lib/Moose/Manual/Attributes.pod +++ b/lib/Moose/Manual/Attributes.pod @@ -575,6 +575,35 @@ As a consequence, any method modifiers defined on the attribute's accessors in an ancestor class will effectively be ignored, because the new accessors live in the child class and do not see the modifiers from the parent class. +=head2 Clearing Aspects + +Sometimes, you may decide that you don't want to override an aspect of the +original attribute with a new value; rather, you want there to be I. +(For instance, the default would normally have been a value that is no longer +valid; but undef or the empty string aren't valid either.) In situations like +this, prepend the attribute name with C: e.g. + + person Person::Archaic; + + use Moose; + + has 'gender' => ( + is => 'ro', + isa => 'Gender', + default => 'Male', + ); + + package Person::Modern; + + use Moose; + extends 'Person::Archaic'; + + has '+gender' => ( + is => 'rw', + clear_default => 1, + required => 1, + ); + =head1 MULTIPLE ATTRIBUTE SHORTCUTS If you have a number of attributes that differ only by name, you can declare From 223cb17daea250dcc9d6255336ea689690dadf3c Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Fri, 19 Jun 2020 20:30:41 +0100 Subject: [PATCH 4/8] Don't let people clear attributes that don't exist. --- .../Exception/InvalidClearedAttribute.pm | 21 +++++++++++++++++++ lib/Moose/Meta/Attribute.pm | 5 ++++- t/attributes/attribute_inherited_slot_specs.t | 3 +++ 3 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 lib/Moose/Exception/InvalidClearedAttribute.pm diff --git a/lib/Moose/Exception/InvalidClearedAttribute.pm b/lib/Moose/Exception/InvalidClearedAttribute.pm new file mode 100644 index 000000000..44f778827 --- /dev/null +++ b/lib/Moose/Exception/InvalidClearedAttribute.pm @@ -0,0 +1,21 @@ +package Moose::Exception::InvalidClearedAttribute; +our $VERSION = '2.2013'; + +use Moose; +extends 'Moose::Exception'; +with 'Moose::Exception::Role::ParamsHash'; + +has 'attribute_name' => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +sub _build_message { + my $self = shift; + "You said clear_" . $self->attribute_name . " but " . $self->attribute_name + . " is not the name of an existing attribute"; +} + +__PACKAGE__->meta->make_immutable; +1; diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 9efac707e..211cacd5d 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -251,7 +251,6 @@ sub clone { } ### TODO: can't say default => 'foo' and clear_default => 1 - ### TODO: can't say clear_brush if brush isn't a valid attribute name ### TODO: test that clear_attribute_name if attribute_name isn't set ### does nothing. for my $param_name (keys %params) { @@ -259,6 +258,10 @@ sub clone { my $cleared_attr_name = $1; if ($attr_by_name{$cleared_attr_name}) { delete $new_params{$cleared_attr_name}; + } else { + throw_exception( InvalidClearedAttribute => attribute_name => $cleared_attr_name, + params => \%params + ); } } else { $new_params{$param_name} = $params{$param_name}; diff --git a/t/attributes/attribute_inherited_slot_specs.t b/t/attributes/attribute_inherited_slot_specs.t index 7e76ef7c4..c361cf1dc 100644 --- a/t/attributes/attribute_inherited_slot_specs.t +++ b/t/attributes/attribute_inherited_slot_specs.t @@ -120,6 +120,9 @@ use Test::Fatal; extends 'Foo'; + ::like( ::exception { + has '+bar' => (clear_brush => 'I live in Texas, I just do this') + }, qr/You said clear_brush but/, 'Cannot clear a non-existent attribute'); ::is( ::exception { has '+bar' => (clear_default => 1); }, undef, 'Can clear a previous default'); From 8316b798e7125c0b718753072eec5199e973c457 Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Fri, 19 Jun 2020 21:24:53 +0100 Subject: [PATCH 5/8] Don't let people say both clear_default *and* provide a default value. --- ...AttributeAndClearAttributeAreNotAllowed.pm | 21 +++++++++++++++++++ lib/Moose/Meta/Attribute.pm | 6 +++++- t/attributes/attribute_inherited_slot_specs.t | 6 +++++- 3 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 lib/Moose/Exception/BothAttributeAndClearAttributeAreNotAllowed.pm diff --git a/lib/Moose/Exception/BothAttributeAndClearAttributeAreNotAllowed.pm b/lib/Moose/Exception/BothAttributeAndClearAttributeAreNotAllowed.pm new file mode 100644 index 000000000..7b52a63d4 --- /dev/null +++ b/lib/Moose/Exception/BothAttributeAndClearAttributeAreNotAllowed.pm @@ -0,0 +1,21 @@ +package Moose::Exception::BothAttributeAndClearAttributeAreNotAllowed; +our $VERSION = '2.2013'; + +use Moose; +extends 'Moose::Exception'; +with 'Moose::Exception::Role::ParamsHash'; + +has 'attribute_name' => ( + is => 'ro', + isa => 'Str', + required => 1 +); + +sub _build_message { + my $self = shift; + return "You said both to clear_" . $self->attribute_name + . " and also to set a value for " . $self->attribute_name; +} + +__PACKAGE__->meta->make_immutable; +1; diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 211cacd5d..7b5222bc0 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -250,13 +250,17 @@ sub clone { } } - ### TODO: can't say default => 'foo' and clear_default => 1 ### TODO: test that clear_attribute_name if attribute_name isn't set ### does nothing. for my $param_name (keys %params) { if ($param_name =~ /^ clear_ (.+) /x) { my $cleared_attr_name = $1; if ($attr_by_name{$cleared_attr_name}) { + if ($params{$cleared_attr_name}) { + throw_exception( BothAttributeAndClearAttributeAreNotAllowed => attribute_name => $cleared_attr_name, + params => \%params + ); + } delete $new_params{$cleared_attr_name}; } else { throw_exception( InvalidClearedAttribute => attribute_name => $cleared_attr_name, diff --git a/t/attributes/attribute_inherited_slot_specs.t b/t/attributes/attribute_inherited_slot_specs.t index c361cf1dc..a96eaf242 100644 --- a/t/attributes/attribute_inherited_slot_specs.t +++ b/t/attributes/attribute_inherited_slot_specs.t @@ -121,8 +121,12 @@ use Test::Fatal; extends 'Foo'; ::like( ::exception { - has '+bar' => (clear_brush => 'I live in Texas, I just do this') + has '+bar' => (clear_brush => 'I live in Texas, I just do this'); }, qr/You said clear_brush but/, 'Cannot clear a non-existent attribute'); + ::like( ::exception { + has '+bar' => (clear_default => 1, default => 'Something reasonable'); + }, qr/You said both to clear_default and also to set a value for default/, + 'Must be consistent: default value or no default value?'); ::is( ::exception { has '+bar' => (clear_default => 1); }, undef, 'Can clear a previous default'); From ea2e8e1e10a2acd822e481a950d1697486947626 Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Fri, 19 Jun 2020 21:28:46 +0100 Subject: [PATCH 6/8] Obviously make sure that if you clear an already-empty attribute, that works and nothing complains. --- lib/Moose/Meta/Attribute.pm | 2 -- t/attributes/attribute_inherited_slot_specs.t | 4 ++++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 7b5222bc0..49d1f3b62 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -250,8 +250,6 @@ sub clone { } } - ### TODO: test that clear_attribute_name if attribute_name isn't set - ### does nothing. for my $param_name (keys %params) { if ($param_name =~ /^ clear_ (.+) /x) { my $cleared_attr_name = $1; diff --git a/t/attributes/attribute_inherited_slot_specs.t b/t/attributes/attribute_inherited_slot_specs.t index a96eaf242..b27d4b285 100644 --- a/t/attributes/attribute_inherited_slot_specs.t +++ b/t/attributes/attribute_inherited_slot_specs.t @@ -115,6 +115,10 @@ use Test::Fatal; has '+does_not_exist' => (isa => 'Str'); }, qr/in Bar/, '... cannot extend a non-existing attribute' ); + ::is( ::exception { + has '+baz' => (clear_default => 1), + }, undef, 'Can trivially clear an already-cleared attribute'); + package Foo::VagueBar; use Moose; From 018e5a0a9ca22d51d26a146ddc7c5321e1e06422 Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Fri, 19 Jun 2020 23:26:57 +0100 Subject: [PATCH 7/8] Still complain if we provide a default value *and* clear_value, but the default value is false. --- lib/Moose/Meta/Attribute.pm | 2 +- t/attributes/attribute_inherited_slot_specs.t | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 49d1f3b62..a4c7d635e 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -254,7 +254,7 @@ sub clone { if ($param_name =~ /^ clear_ (.+) /x) { my $cleared_attr_name = $1; if ($attr_by_name{$cleared_attr_name}) { - if ($params{$cleared_attr_name}) { + if (exists $params{$cleared_attr_name}) { throw_exception( BothAttributeAndClearAttributeAreNotAllowed => attribute_name => $cleared_attr_name, params => \%params ); diff --git a/t/attributes/attribute_inherited_slot_specs.t b/t/attributes/attribute_inherited_slot_specs.t index b27d4b285..ec882a716 100644 --- a/t/attributes/attribute_inherited_slot_specs.t +++ b/t/attributes/attribute_inherited_slot_specs.t @@ -127,10 +127,16 @@ use Test::Fatal; ::like( ::exception { has '+bar' => (clear_brush => 'I live in Texas, I just do this'); }, qr/You said clear_brush but/, 'Cannot clear a non-existent attribute'); + my $re_make_up_your_mind + = qr/You said both to clear_default and also to set a value for default/; ::like( ::exception { has '+bar' => (clear_default => 1, default => 'Something reasonable'); - }, qr/You said both to clear_default and also to set a value for default/, + }, $re_make_up_your_mind, 'Must be consistent: default value or no default value?'); + ::like( ::exception { + has '+bar' => (clear_default => 1, default => 0); + }, $re_make_up_your_mind, + '...including when the new default value is false'); ::is( ::exception { has '+bar' => (clear_default => 1); }, undef, 'Can clear a previous default'); From ac11c036b047a74f3017233a24e8eac0dcf865f2 Mon Sep 17 00:00:00 2001 From: Sam Kington Date: Fri, 19 Jun 2020 23:27:11 +0100 Subject: [PATCH 8/8] White space shenanigans. --- lib/Moose/Manual/Attributes.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Moose/Manual/Attributes.pod b/lib/Moose/Manual/Attributes.pod index 424cea3c0..e3b9342a1 100644 --- a/lib/Moose/Manual/Attributes.pod +++ b/lib/Moose/Manual/Attributes.pod @@ -597,7 +597,7 @@ this, prepend the attribute name with C: e.g. use Moose; extends 'Person::Archaic'; - + has '+gender' => ( is => 'rw', clear_default => 1,