[libmoo-perl] 18/43: refactor attribute spec merging into accessor generator
gregor herrmann
gregoa at debian.org
Mon Dec 26 17:56:14 UTC 2016
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository libmoo-perl.
commit c7609191e68a6fd8b4651e67f36eceb8ca69d7a6
Author: Graham Knop <haarg at haarg.org>
Date: Sun Nov 27 01:54:48 2016 -0500
refactor attribute spec merging into accessor generator
---
lib/Method/Generate/Accessor.pm | 19 +++++++++++++++++++
lib/Method/Generate/Constructor.pm | 16 +++-------------
2 files changed, 22 insertions(+), 13 deletions(-)
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index aec2585..90bd92b 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -251,6 +251,25 @@ sub generate_method {
\%methods;
}
+sub merge_specs {
+ my ($self, @specs) = @_;
+ my $spec = shift @specs;
+ for my $old_spec (@specs) {
+ foreach my $key (keys %$old_spec) {
+ next
+ if $key eq 'handles' || exists $spec->{$key};
+ $spec->{$key}
+ = $key eq 'moosify'
+ ? [
+ map { ref $_ eq 'ARRAY' ? @$_ : $_ }
+ ($old_spec->{$key}, $spec->{$key})
+ ]
+ : $old_spec->{$key};
+ }
+ }
+ $spec;
+}
+
sub is_simple_attribute {
my ($self, $name, $spec) = @_;
# clearer doesn't have to be listed because it doesn't
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 56b85cc..975939c 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -19,26 +19,16 @@ sub register_attribute_specs {
my ($self, @new_specs) = @_;
$self->assert_constructor;
my $specs = $self->{attribute_specs}||={};
+ my $ag = $self->accessor_generator;
while (my ($name, $new_spec) = splice @new_specs, 0, 2) {
if ($name =~ s/^\+//) {
croak "has '+${name}' given but no ${name} attribute already exists"
unless my $old_spec = $specs->{$name};
- foreach my $key (keys %$old_spec) {
- if (!exists $new_spec->{$key}) {
- $new_spec->{$key} = $old_spec->{$key}
- unless $key eq 'handles';
- }
- elsif ($key eq 'moosify') {
- $new_spec->{$key} = [
- map { ref $_ eq 'ARRAY' ? @$_ : $_ }
- ($old_spec->{$key}, $new_spec->{$key})
- ];
- }
- }
+ $ag->merge_specs($new_spec, $old_spec);
}
if ($new_spec->{required}
&& !(
- $self->accessor_generator->has_default($name, $new_spec)
+ $ag->has_default($name, $new_spec)
|| !exists $new_spec->{init_arg}
|| defined $new_spec->{init_arg}
)
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoo-perl.git
More information about the Pkg-perl-cvs-commits
mailing list