search spec components factored out of T365

[catagits/Reaction.git] / lib / Reaction / Meta / Attribute.pm

diff --git a/lib/Reaction/Meta/Attribute.pm b/lib/Reaction/Meta/Attribute.pm
index 16e5ed9..b6ea1a0 100644 (file)
--- a/lib/Reaction/Meta/Attribute.pm
+++ b/lib/Reaction/Meta/Attribute.pm
@@ -8,6 +8,10 @@ extends 'Moose::Meta::Attribute';
 has lazy_fail  =>
     (is => 'ro', reader => 'is_lazy_fail',  required => 1, default => 0);
 
+around legal_options_for_inheritance => sub {
+  return (shift->(@_), qw/valid_values/);
+};
+
 around _process_options => sub {
     my $super = shift;
     my ($class, $name, $options) = @_;
@@ -30,6 +34,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;