From: Matt Phillips <mattp@cpan.org>
Date: Fri, 22 Mar 2013 20:35:43 +0000 (-0400)
Subject: Adds moosify isa spec
X-Git-Tag: v1.002000~20
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7887ffd0e1ad2fb8ce47acf35c23cdb14d47b151;p=gitmo%2FMoo.git

Adds moosify isa spec

This feature is an optional coderef that gets fired when Moo::HandleMoose is
injecting a real metaclass. The spec hashref is passed as the only argument to
allow for modifications to carry forward to Moose.

The main usecase for this is to allow thirdparty extensions such as
MooX::HandlesVia to mutate their Moo specific attributes to something Moose
will understand.
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 2f2e334..cdba23f 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -66,28 +66,26 @@ sub generate_method {
     $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
   }
 
-  if (exists $spec->{coerce}) {
-    my $value = $spec->{coerce};
-    my $invalid = "Invalid coerce '" . overload::StrVal($value)
-      . "' for $into->$name - not a coderef";
-    die "$invalid or code-convertible object"
-      unless ref $value and (ref $value eq 'CODE' or blessed($value));
-    die "$invalid and could not be converted to a coderef: $@"
-      if !eval { \&$value };
+  for my $setting (qw( isa coerce )) {
+    next if !exists $spec->{$setting};
+    $self->_validate_codulatable($setting, $spec->{$setting}, "$into->$name");
   }
 
   if (exists $spec->{default}) {
-    my $value = $spec->{default};
-    if (!defined $value || ref $value) {
-      my $invalid = "Invalid default '" . overload::StrVal($value)
-        . "' for $into->$name - not a coderef or non-ref";
-      die "$invalid or code-convertible object"
-        unless ref $value and (ref $value eq 'CODE' or blessed($value));
-      die "$invalid and could not be converted to a coderef: $@"
-        if !eval { \&$value };
+    if (!defined $spec->{default} || ref $spec->{default}) {
+      $self->_validate_codulatable('default', $spec->{default}, "$into->$name", 'or a non-ref');
     }
   }
 
+  if (exists $spec->{moosify}) {
+    if (ref $spec->{moosify} ne 'ARRAY') {
+      $spec->{moosify} = [$spec->{moosify}];
+    }
+
+    for my $spec (@{$spec->{moosify}}) {
+      $self->_validate_codulatable('moosify', $spec, "$into->$name");
+    }
+  }
 
   my %methods;
   if (my $reader = $spec->{reader}) {
@@ -570,4 +568,16 @@ sub _generate_xs {
 
 sub default_construction_string { '{}' }
 
+sub _validate_codulatable {
+  my ($self, $setting, $value, $into, $appended) = @_;
+  $appended ||= '';
+  my $invalid = "Invalid $setting '" . overload::StrVal($value)
+    . "' for $into not a coderef $appended";
+  die "$invalid or code-convertible object"
+    unless ref $value and (ref $value eq 'CODE' or blessed($value));
+  die "$invalid and could not be converted to a coderef: $@"
+    if !eval { \&$value };
+  1;
+}
+
 1;
diff --git a/lib/Moo.pm b/lib/Moo.pm
index 46d6e5a..4ef6ab1 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -645,6 +645,15 @@ common use of this is to make an underscored attribute have a non-underscored
 initialization name. C<undef> means that passing the value in on instantiation
 is ignored.
 
+=item * C<moosify>
+
+Takes either a coderef or array of coderefs which is meant to transform the
+given attributes specifications if necessary when upgrading to a Moose role or
+class. You shouldn't need this by default, but is provided as a means of
+possible extensibility.
+
+L<Sub::Quote aware|/SUB QUOTE AWARE>
+
 =back
 
 =head2 before
diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
index b68d19a..8b19839 100644
--- a/lib/Moo/HandleMoose.pm
+++ b/lib/Moo/HandleMoose.pm
@@ -73,6 +73,12 @@ sub inject_real_metaclass_for {
     }
   };
 
+  for my $spec (values %$attr_specs) {
+    if (my $inflators = delete $spec->{moosify}) {
+      $_->($spec) for @$inflators;
+    }
+  }
+
   my %methods = %{Role::Tiny->_concrete_methods_of($name)};
 
   # if stuff gets added afterwards, _maybe_reset_handlemoose should
diff --git a/xt/moo-does-moose-role.t b/xt/moo-does-moose-role.t
index c1be1fd..3847287 100644
--- a/xt/moo-does-moose-role.t
+++ b/xt/moo-does-moose-role.t
@@ -137,6 +137,44 @@ BEGIN {
   sub jab { 3 }
 }
 
+BEGIN {
+  package Plunk;
+
+  use Moo::Role;
+
+  has pp => (is => 'rw', moosify => sub {
+    my $spec = shift;
+    $spec->{documentation} = 'moosify';
+  });
+}
+
+BEGIN {
+  package Plank;
+
+  use Moo;
+  use Sub::Quote;
+
+  has vv => (is => 'rw', moosify => [quote_sub(q|
+    $_[0]->{documentation} = 'moosify';
+  |), sub { $_[0]->{documentation} = $_[0]->{documentation}.' foo'; }]);
+}
+
+BEGIN {
+  package Plunker;
+
+  use Moose;
+
+  with 'Plunk';
+}
+
+BEGIN {
+  package Planker;
+
+  use Moose;
+
+  extends 'Plank';
+}
+
 foreach my $s (
     Splattered->new,
     Splattered2->new,
@@ -165,5 +203,9 @@ foreach my $c (qw/
   ok $c->can('has_splat');
 }
 
-done_testing;
+foreach my $c (Plunker->new) {
+  is(Plunker->meta->find_attribute_by_name('pp')->documentation, 'moosify', 'moosify modifies attr specs');
+  is(Planker->meta->find_attribute_by_name('vv')->documentation, 'moosify foo', 'moosify modifies attr specs as array');
+}
 
+done_testing;