diff options
author | matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7> | 2008-03-05 19:15:30 +0000 |
---|---|---|
committer | matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7> | 2008-03-05 19:15:30 +0000 |
commit | 4949e0ee7a1162bca838822095e6cd2da527e2d2 (patch) | |
tree | 6ca87a2bb118f1abd37ffd04e91f058c9ec1e3b8 /lib/Reaction/Meta | |
parent | 335754e0e6a978284ab11afcc9c3d9da237df52c (diff) | |
download | reaction-4949e0ee7a1162bca838822095e6cd2da527e2d2.tar.gz reaction-4949e0ee7a1162bca838822095e6cd2da527e2d2.zip |
rewrite IM predicates
Diffstat (limited to 'lib/Reaction/Meta')
-rw-r--r-- | lib/Reaction/Meta/Attribute.pm | 30 |
1 files changed, 30 insertions, 0 deletions
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; |