From: Matt S Trout Date: Mon, 8 Nov 2010 05:15:06 +0000 (+0000) Subject: add predicate and clearer X-Git-Tag: 0.009001~52 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8f3335481794bd996b3b8e7b6752958b4788fd52;p=gitmo%2FRole-Tiny.git add predicate and clearer --- diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm index 79f2e91..3a33844 100644 --- a/lib/Method/Generate/Accessor.pm +++ b/lib/Method/Generate/Accessor.pm @@ -19,6 +19,16 @@ sub generate_method { die "Unknown is ${is}"; } }; + if (my $pred = $spec->{predicate}) { + quote_sub "${into}::${pred}" => + ' '.$self->_generate_simple_has('$_[0]', $name)."\n" + ; + } + if (my $cl = $spec->{clearer}) { + quote_sub "${into}::${cl}" => + " delete \$_[0]->{${\perlstring $name}}\n" + ; + } quote_sub "${into}::${name}" => ' '.$body."\n", $self->{captures}, $quote_opts||{} @@ -27,7 +37,10 @@ sub generate_method { sub is_simple_attribute { my ($self, $name, $spec) = @_; - return !grep $spec->{$_}, qw(lazy default builder isa trigger); + # clearer doesn't have to be listed because it doesn't + # affect whether defined/exists makes a difference + return !grep $spec->{$_}, + qw(lazy default builder isa trigger predicate); } sub _generate_get { diff --git a/t/accessor-pred-clear.t b/t/accessor-pred-clear.t new file mode 100644 index 0000000..7d505c2 --- /dev/null +++ b/t/accessor-pred-clear.t @@ -0,0 +1,25 @@ +use strictures 1; +use Test::More; + +{ + package Foo; + + use Class::Tiny; + + has one => ( + is => 'ro', lazy => 1, default => sub { 3 }, + predicate => 'has_one', clearer => 'clear_one' + ); +} + +my $foo = Foo->new; + +ok(!$foo->has_one, 'empty'); +is($foo->one, 3, 'lazy default'); +ok($foo->has_one, 'not empty now'); +is($foo->clear_one, 3, 'clearer returns value'); +ok(!$foo->has_one, 'clearer empties'); +is($foo->one, 3, 'default re-fired'); +ok($foo->has_one, 'not empty again'); + +done_testing;