From: Christian Walde 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: + If you set this to just C<1>, the builder is automatically named -C<_build_${attr_name}>. This feature comes from L. +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 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;