[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