From: Christian Walde <walde.christian@googlemail.com>
Date: Thu, 10 Jan 2013 13:56:11 +0000 (+0100)
Subject: builder => sub{} now installs that as a method
X-Git-Tag: v1.000008~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4752c97bb22149613a59912fa5a23b865cadef54;hp=12a1f8f1e70065c3e9288af938113f1367969bc1;p=gitmo%2FMoo.git

builder => sub{} now installs that as a method
---

diff --git a/Changes b/Changes
index c917e1f..f04f028 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - Support builder => sub {} ala MooseX::AttributeShortcuts
   - Fix 'no Moo;' to preserve non-sub package variables
   - Switch to testing for Mouse::Util->can('find_meta') to avoid
     exploding on ancient Mouse installs
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 73ad15d..7a7bc26 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -35,10 +35,19 @@ sub generate_method {
   } elsif ($is ne 'bare') {
     die "Unknown is ${is}";
   }
-  $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1;
-  die "Invalid builder for $into->$name - not a valid method name"
-    if exists $spec->{builder} and (ref $spec->{builder}
-      or $spec->{builder} !~ /\A[A-Za-z_][A-Za-z0-9_]*(?:::[A-Za-z_][A-Za-z0-9_]*)*\z/);
+  if (exists $spec->{builder}) {
+    if(ref $spec->{builder}) {
+      die "Invalid builder for $into->$name - not a method name, coderef or"
+        . " code-convertible object"
+        unless ref $spec->{builder} eq 'CODE'
+        or (blessed($spec->{builder}) and eval { \&{$spec->{builder}} });
+      $spec->{builder_sub} = $spec->{builder};
+      $spec->{builder} = 1;
+    }
+    $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1;
+    die "Invalid builder for $into->$name - not a valid method name"
+      if $spec->{builder} !~ /\A[A-Za-z_][A-Za-z0-9_]*(?:::[A-Za-z_][A-Za-z0-9_]*)*\z/;
+  }
   if (($spec->{predicate}||0) eq 1) {
     $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}";
   }
@@ -117,6 +126,9 @@ sub generate_method {
         '    '.$self->_generate_simple_has('$_[0]', $name, $spec)."\n"
       ;
   }
+  if (my $pred = $spec->{builder_sub}) {
+    _install_coderef( "${into}::$spec->{builder}" => $spec->{builder_sub} );
+  }
   if (my $cl = $spec->{clearer}) {
     $methods{$cl} =
       quote_sub "${into}::${cl}" => 
diff --git a/lib/Moo.pm b/lib/Moo.pm
index 8061541..acf7c65 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -556,8 +556,14 @@ Moo will call
 
   $self->$builder;
 
+The following features come from L<MooseX::AttributeShortcuts>:
+
 If you set this to just C<1>, the builder is automatically named
-C<_build_${attr_name}>.  This feature comes from L<MooseX::AttributeShortcuts>.
+C<_build_${attr_name}>.
+
+If you set this to a coderef or code-convertible object, that variable will be
+installed under C<$class::_build_${attr_name}> and the builder set to the same
+name.
 
 =item * C<clearer>
 
diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t
index 74a6aae..64dbfee 100644
--- a/t/method-generate-accessor.t
+++ b/t/method-generate-accessor.t
@@ -3,6 +3,7 @@ use Test::More;
 use Test::Fatal;
 
 use Method::Generate::Accessor;
+use Sub::Quote 'quote_sub';
 
 my $gen = Method::Generate::Accessor->new;
 
@@ -73,9 +74,9 @@ is(
   undef, 'builder - string accepted',
 );
 
-like(
+is(
   exception { $gen->generate_method('Foo' => 'eleven' => { is => 'ro', builder => sub {} }) },
-  qr/Invalid builder/, 'builder - coderef rejected'
+  undef, 'builder - coderef accepted'
 );
 
 like(
@@ -88,6 +89,16 @@ is(
   undef, 'builder - fully-qualified name accepted',
 );
 
+is(
+  exception { $gen->generate_method('Foo' => 'fifteen' => { is => 'lazy', builder => sub {15} }) },
+  undef, 'builder - coderef accepted'
+);
+
+is(
+  exception { $gen->generate_method('Foo' => 'sixteen' => { is => 'lazy', builder => quote_sub q{ 16 } }) },
+  undef, 'builder - quote_sub accepted'
+);
+
 my $foo = Foo->new(one => 1);
 
 is($foo->one, 1, 'ro reads');
@@ -98,4 +109,9 @@ is($foo->two, undef, 'rw reads');
 $foo->two(-3);
 is($foo->two, -3, 'rw writes');
 
+is($foo->fifteen, 15, 'builder installs code sub');
+is($foo->_build_fifteen, 15, 'builder installs code sub under the correct name');
+
+is($foo->sixteen, 16, 'builder installs quote_sub');
+
 done_testing;