From: Matt S Trout <mst@shadowcat.co.uk>
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%2FMoo.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;