X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FReaction%2FMeta%2FAttribute.pm;h=a925982cd6aff9ba0ae50a5d9a895d1f703b861d;hb=1190b47503b6c022438520ca85d0af47d8474669;hp=16e5ed963811cae9c803f76da56190d030f89dfc;hpb=89939ff9e89dbee9a8e4e7b8a5614f1fff0a74ae;p=catagits%2FReaction.git

diff --git a/lib/Reaction/Meta/Attribute.pm b/lib/Reaction/Meta/Attribute.pm
index 16e5ed9..a925982 100644
--- a/lib/Reaction/Meta/Attribute.pm
+++ b/lib/Reaction/Meta/Attribute.pm
@@ -30,6 +30,36 @@ around _process_options => sub {
     $super->($class, $name, $options);
 };
 
+foreach my $type (qw(clearer predicate)) {
+
+  my $value_meth = do {
+    if ($type eq 'clearer') {
+      'clear_value'
+    } elsif ($type eq 'predicate') {
+      'has_value'
+    } else {
+      confess "NOTREACHED";
+    }
+  };
+
+  __PACKAGE__->meta->add_method("get_${type}_method" => sub {
+    my $self = shift;
+    my $info = $self->$type;
+    return $info unless ref $info;
+    my ($name) = %$info;
+    return $name;
+  });
+
+  __PACKAGE__->meta->add_method("get_${type}_method_ref" => sub {
+    my $self = shift;
+    if ((my $name = $self->${\"get_${type}_method"}) && $self->associated_class) {
+        return $self->associated_class->get_method($name);
+    } else {
+        return sub { $self->$value_meth(@_); }
+    }
+  });
+}
+
 __PACKAGE__->meta->make_immutable(inline_constructor => 0);
 
 1;