use strict;
use warnings;
-use Scalar::Util 'blessed', 'weaken', 'reftype';
-use Carp 'confess';
-use Sub::Name 'subname';
+use Scalar::Util 'blessed', 'weaken';
use overload ();
-our $VERSION = '0.22';
+our $VERSION = '0.61';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
+use Moose::Meta::Method::Delegation;
use Moose::Util ();
use Moose::Util::TypeConstraints ();
predicate => 'has_applied_traits',
));
-# NOTE:
# we need to have a ->does method in here to
# more easily support traits, and the introspection
-# of those traits. So in order to do this we
-# just alias Moose::Object's version of it.
-# - SL
-*does = \&Moose::Object::does;
+# of those traits. We extend the does check to look
+# for metatrait aliases.
+sub does {
+ my ($self, $role_name) = @_;
+ my $name = eval {
+ Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
+ };
+ return 0 if !defined($name); # failed to load class
+ return $self->Moose::Object::does($name);
+}
+
+sub throw_error {
+ my $self = shift;
+ my $class = ( ref $self && $self->associated_class ) || "Moose::Meta::Class";
+ unshift @_, "message" if @_ % 2 == 1;
+ unshift @_, attr => $self if ref $self;
+ unshift @_, $class;
+ my $handler = $class->can("throw_error"); # to avoid incrementing depth by 1
+ goto $handler;
+}
sub new {
my ($class, $name, %options) = @_;
- $class->_process_options($name, \%options);
+ $class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
return $class->SUPER::new($name, %options);
}
sub interpolate_class_and_new {
my ($class, $name, @args) = @_;
- $class->interpolate_class(@args)->new($name, @args);
+ my ( $new_class, @traits ) = $class->interpolate_class(@args);
+
+ $new_class->new($name, @args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
}
sub interpolate_class {
my ($class, %options) = @_;
- if ( my $metaclass_name = $options{metaclass} ) {
- $class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
+ $class = ref($class) || $class;
+
+ if ( my $metaclass_name = delete $options{metaclass} ) {
+ my $new_class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
+
+ if ( $class ne $new_class ) {
+ if ( $new_class->can("interpolate_class") ) {
+ return $new_class->interpolate_class(%options);
+ } else {
+ $class = $new_class;
+ }
+ }
}
+ my @traits;
+
if (my $traits = $options{traits}) {
- my @traits = map {
+ if ( @traits = grep { not $class->does($_) } map {
Moose::Util::resolve_metatrait_alias( Attribute => $_ )
or
$_
- } @$traits;
-
- my $anon_class = Moose::Meta::Class->create_anon_class(
- superclasses => [ $class ],
- roles => [ @traits ],
- cache => 1,
- );
-
- return $anon_class->name;
- }
- else {
- return $class;
+ } @$traits ) {
+ my $anon_class = Moose::Meta::Class->create_anon_class(
+ superclasses => [ $class ],
+ roles => [ @traits ],
+ cache => 1,
+ );
+
+ $class = $anon_class->name;
+ }
}
+
+ return ( wantarray ? ( $class, @traits ) : $class );
}
+# ...
+
+my @legal_options_for_inheritance = qw(
+ default coerce required
+ documentation lazy handles
+ builder type_constraint
+);
+
+sub legal_options_for_inheritance { @legal_options_for_inheritance }
+
+# NOTE/TODO
+# This method *must* be able to handle
+# Class::MOP::Attribute instances as
+# well. Yes, I know that is wrong, but
+# apparently we didn't realize it was
+# doing that and now we have some code
+# which is dependent on it. The real
+# solution of course is to push this
+# feature back up into Class::MOP::Attribute
+# but I not right now, I am too lazy.
+# However if you are reading this and
+# looking for something to do,.. please
+# be my guest.
+# - stevan
sub clone_and_inherit_options {
my ($self, %options) = @_;
- # you can change default, required, coerce, documentation, lazy, handles, builder, metaclass and traits
+
+ my %copy = %options;
+
my %actual_options;
- foreach my $legal_option (qw(default coerce required documentation lazy handles builder metaclass traits)) {
+
+ # NOTE:
+ # we may want to extends a Class::MOP::Attribute
+ # in which case we need to be able to use the
+ # core set of legal options that have always
+ # been here. But we allows Moose::Meta::Attribute
+ # instances to changes them.
+ # - SL
+ my @legal_options = $self->can('legal_options_for_inheritance')
+ ? $self->legal_options_for_inheritance
+ : @legal_options_for_inheritance;
+
+ foreach my $legal_option (@legal_options) {
if (exists $options{$legal_option}) {
$actual_options{$legal_option} = $options{$legal_option};
delete $options{$legal_option};
}
- }
+ }
if ($options{isa}) {
my $type_constraint;
else {
$type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa});
(defined $type_constraint)
- || confess "Could not find the type constraint '" . $options{isa} . "'";
+ || $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa});
}
$actual_options{type_constraint} = $type_constraint;
else {
$type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does});
(defined $type_constraint)
- || confess "Could not find the type constraint '" . $options{does} . "'";
+ || $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does});
}
$actual_options{type_constraint} = $type_constraint;
delete $options{does};
}
-
+
+ # NOTE:
+ # this doesn't apply to Class::MOP::Attributes,
+ # so we can ignore it for them.
+ # - SL
+ if ($self->can('interpolate_class')) {
+ ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(%options);
+
+ my %seen;
+ my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits;
+ $actual_options{traits} = \@all_traits if @all_traits;
+
+ delete @options{qw(metaclass traits)};
+ }
+
(scalar keys %options == 0)
- || confess "Illegal inherited options => (" . (join ', ' => keys %options) . ")";
+ || $self->throw_error("Illegal inherited options => (" . (join ', ' => keys %options) . ")", data => \%options);
+
+
$self->clone(%actual_options);
}
+sub clone {
+ my ( $self, %params ) = @_;
+
+ my $class = $params{metaclass} || ref $self;
+
+ if ( 0 and $class eq ref $self ) {
+ return $self->SUPER::clone(%params);
+ } else {
+ my ( @init, @non_init );
+
+ foreach my $attr ( grep { $_->has_value($self) } $self->meta->compute_all_applicable_attributes ) {
+ push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
+ }
+
+ my %new_params = ( ( map { $_->init_arg => $_->get_value($self) } @init ), %params );
+
+ my $name = delete $new_params{name};
+
+ my $clone = $class->new($name, %new_params, __hack_no_process_options => 1 );
+
+ foreach my $attr ( @non_init ) {
+ $attr->set_value($clone, $attr->get_value($self));
+ }
+
+
+ return $clone;
+ }
+}
+
sub _process_options {
my ($class, $name, $options) = @_;
if (exists $options->{is}) {
+
+ ### -------------------------
+ ## is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
+ ## is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
+ ## is => rw, accessor => _foo # turns into (accessor => _foo)
+ ## is => ro, accessor => _foo # error, accesor is rw
+ ### -------------------------
+
if ($options->{is} eq 'ro') {
+ $class->throw_error("Cannot define an accessor name on a read-only attribute, accessors are read/write", data => $options)
+ if exists $options->{accessor};
$options->{reader} ||= $name;
- (!exists $options->{trigger})
- || confess "Cannot have a trigger on a read-only attribute $name";
}
elsif ($options->{is} eq 'rw') {
- $options->{accessor} = $name;
- ((reftype($options->{trigger}) || '') eq 'CODE')
- || confess "Trigger must be a CODE ref"
- if exists $options->{trigger};
+ if ($options->{writer}) {
+ $options->{reader} ||= $name;
+ }
+ else {
+ $options->{accessor} ||= $name;
+ }
}
else {
- confess "I do not understand this option (is => " . $options->{is} . ") on attribute $name"
+ $class->throw_error("I do not understand this option (is => " . $options->{is} . ") on attribute ($name)", data => $options->{is});
}
}
if (exists $options->{does}) {
if (eval { $options->{isa}->can('does') }) {
($options->{isa}->does($options->{does}))
- || confess "Cannot have an isa option and a does option if the isa does not do the does on attribute $name";
+ || $class->throw_error("Cannot have an isa option and a does option if the isa does not do the does on attribute ($name)", data => $options);
}
else {
- confess "Cannot have an isa option which cannot ->does() on attribute $name";
+ $class->throw_error("Cannot have an isa option which cannot ->does() on attribute ($name)", data => $options);
}
}
if (exists $options->{coerce} && $options->{coerce}) {
(exists $options->{type_constraint})
- || confess "You cannot have coercion without specifying a type constraint on attribute $name";
- confess "You cannot have a weak reference to a coerced value on attribute $name"
+ || $class->throw_error("You cannot have coercion without specifying a type constraint on attribute ($name)", data => $options);
+ $class->throw_error("You cannot have a weak reference to a coerced value on attribute ($name)", data => $options)
if $options->{weak_ref};
}
+ if (exists $options->{trigger}) {
+ ('CODE' eq ref $options->{trigger})
+ || $class->throw_error("Trigger must be a CODE ref on attribute ($name)", data => $options->{trigger});
+ }
+
if (exists $options->{auto_deref} && $options->{auto_deref}) {
(exists $options->{type_constraint})
- || confess "You cannot auto-dereference without specifying a type constraint on attribute $name";
+ || $class->throw_error("You cannot auto-dereference without specifying a type constraint on attribute ($name)", data => $options);
($options->{type_constraint}->is_a_type_of('ArrayRef') ||
$options->{type_constraint}->is_a_type_of('HashRef'))
- || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name";
+ || $class->throw_error("You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)", data => $options);
}
if (exists $options->{lazy_build} && $options->{lazy_build} == 1) {
- confess("You can not use lazy_build and default for the same attribute $name")
+ $class->throw_error("You can not use lazy_build and default for the same attribute ($name)", data => $options)
if exists $options->{default};
$options->{lazy} = 1;
$options->{required} = 1;
if (exists $options->{lazy} && $options->{lazy}) {
(exists $options->{default} || defined $options->{builder} )
- || confess "You cannot have lazy attribute ($name) without specifying a default value for it";
+ || $class->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it", data => $options);
}
if ( $options->{required} && !( ( !exists $options->{init_arg} || defined $options->{init_arg} ) || exists $options->{default} || defined $options->{builder} ) ) {
- confess "You cannot have a required attribute ($name) without a default, builder, or an init_arg";
+ $class->throw_error("You cannot have a required attribute ($name) without a default, builder, or an init_arg", data => $options);
}
}
# skip it if it's lazy
return if $self->is_lazy;
# and die if it's required and doesn't have a default value
- confess "Attribute (" . $self->name . ") is required"
+ $self->throw_error("Attribute (" . $self->name . ") is required", object => $instance, data => $params)
if $self->is_required && !$self->has_default && !$self->has_builder;
# if nothing was in the %params, we can use the
$value_is_set = 1;
}
elsif ($self->has_builder) {
- if (my $builder = $instance->can($self->builder)){
- $val = $instance->$builder;
- $value_is_set = 1;
- }
- else {
- confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
- }
+ $val = $self->_call_builder($instance);
+ $value_is_set = 1;
}
}
$val = $type_constraint->coerce($val);
}
$type_constraint->check($val)
- || confess "Attribute ("
+ || $self->throw_error("Attribute ("
. $self->name
. ") does not pass the type constraint because: "
- . $type_constraint->get_message($val);
+ . $type_constraint->get_message($val), data => $val, object => $instance);
}
$self->set_initial_value($instance, $val);
if ref $val && $self->is_weak_ref;
}
+sub _call_builder {
+ my ( $self, $instance ) = @_;
+
+ my $builder = $self->builder();
+
+ return $instance->$builder()
+ if $instance->can( $self->builder );
+
+ $self->throw_error( blessed($instance)
+ . " does not support builder method '"
+ . $self->builder
+ . "' for attribute '"
+ . $self->name
+ . "'",
+ object => $instance,
+ );
+}
+
## Slot management
# FIXME:
$val = $type_constraint->coerce($val)
if $can_coerce;
$type_constraint->check($val)
- || confess "Attribute ("
+ || $self->throw_error("Attribute ("
. $slot_name
. ") does not pass the type constraint because: "
- . $type_constraint->get_message($val);
+ . $type_constraint->get_message($val), data => $val, object => $instance);
}
$meta_instance->set_slot_value($instance, $slot_name, $val);
};
}
sub set_value {
- my ($self, $instance, $value) = @_;
+ my ($self, $instance, @args) = @_;
+ my $value = $args[0];
my $attr_name = $self->name;
- if ($self->is_required) {
- defined($value)
- || confess "Attribute ($attr_name) is required, so cannot be set to undef";
+ if ($self->is_required and not @args) {
+ $self->throw_error("Attribute ($attr_name) is required", object => $instance);
}
if ($self->has_type_constraint) {
$value = $type_constraint->coerce($value);
}
$type_constraint->_compiled_type_constraint->($value)
- || confess "Attribute ("
+ || $self->throw_error("Attribute ("
. $self->name
. ") does not pass the type constraint because "
- . $type_constraint->get_message($value);
+ . $type_constraint->get_message($value), object => $instance, data => $value);
}
my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
if ($self->is_lazy) {
unless ($self->has_value($instance)) {
+ my $value;
if ($self->has_default) {
- my $default = $self->default($instance);
- $self->set_initial_value($instance, $default);
+ $value = $self->default($instance);
+ } elsif ( $self->has_builder ) {
+ $value = $self->_call_builder($instance);
}
- if ( $self->has_builder ){
- if (my $builder = $instance->can($self->builder)){
- $self->set_initial_value($instance, $instance->$builder);
- }
- else {
- confess(blessed($instance)
- . " does not support builder method '"
- . $self->builder
- . "' for attribute '"
- . $self->name
- . "'");
- }
- }
- else {
- $self->set_initial_value($instance, undef);
+ if ($self->has_type_constraint) {
+ my $type_constraint = $self->type_constraint;
+ $value = $type_constraint->coerce($value)
+ if ($self->should_coerce);
+ $type_constraint->check($value)
+ || $self->throw_error("Attribute (" . $self->name
+ . ") does not pass the type constraint because: "
+ . $type_constraint->get_message($value), type_constraint => $type_constraint, data => $value);
}
+ $self->set_initial_value($instance, $value);
}
}
return wantarray ? %{ $rv } : $rv;
}
else {
- confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
+ $self->throw_error("Can not auto de-reference the type constraint '" . $type_constraint->name . "'", object => $instance, type_constraint => $type_constraint);
}
}
sub install_accessors {
my $self = shift;
$self->SUPER::install_accessors(@_);
+ $self->install_delegation if $self->has_handles;
+ return;
+}
- if ($self->has_handles) {
+sub remove_accessors {
+ my $self = shift;
+ $self->SUPER::remove_accessors(@_);
+ $self->remove_delegation if $self->has_handles;
+ return;
+}
- # NOTE:
- # Here we canonicalize the 'handles' option
- # this will sort out any details and always
- # return an hash of methods which we want
- # to delagate to, see that method for details
- my %handles = $self->_canonicalize_handles();
-
- # find the accessor method for this attribute
- my $accessor = $self->get_read_method_ref;
- # then unpack it if we need too ...
- $accessor = $accessor->body if blessed $accessor;
-
- # install the delegation ...
- my $associated_class = $self->associated_class;
- foreach my $handle (keys %handles) {
- my $method_to_call = $handles{$handle};
- my $class_name = $associated_class->name;
- my $name = "${class_name}::${handle}";
+sub install_delegation {
+ my $self = shift;
+
+ # NOTE:
+ # Here we canonicalize the 'handles' option
+ # this will sort out any details and always
+ # return an hash of methods which we want
+ # to delagate to, see that method for details
+ my %handles = $self->_canonicalize_handles;
+
+
+ # install the delegation ...
+ my $associated_class = $self->associated_class;
+ foreach my $handle (keys %handles) {
+ my $method_to_call = $handles{$handle};
+ my $class_name = $associated_class->name;
+ my $name = "${class_name}::${handle}";
(!$associated_class->has_method($handle))
- || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
+ || $self->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation", method_name => $handle);
- # NOTE:
- # handles is not allowed to delegate
- # any of these methods, as they will
- # override the ones in your class, which
- # is almost certainly not what you want.
+ # NOTE:
+ # handles is not allowed to delegate
+ # any of these methods, as they will
+ # override the ones in your class, which
+ # is almost certainly not what you want.
- # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
- #cluck("Not delegating method '$handle' because it is a core method") and
- next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
+ # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
+ #cluck("Not delegating method '$handle' because it is a core method") and
+ next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
- if ((reftype($method_to_call) || '') eq 'CODE') {
- $associated_class->add_method($handle => subname $name, $method_to_call);
- }
- else {
- # NOTE:
- # we used to do a goto here, but the
- # goto didn't handle failure correctly
- # (it just returned nothing), so I took
- # that out. However, the more I thought
- # about it, the less I liked it doing
- # the goto, and I prefered the act of
- # delegation being actually represented
- # in the stack trace.
- # - SL
- $associated_class->add_method($handle => subname $name, sub {
- my $proxy = (shift)->$accessor();
- (defined $proxy)
- || confess "Cannot delegate $handle to $method_to_call because " .
- "the value of " . $self->name . " is not defined";
- $proxy->$method_to_call(@_);
- });
- }
- }
- }
+ my $method = $self->_make_delegation_method($handle, $method_to_call);
- return;
+ $self->associated_class->add_method($method->name, $method);
+ }
+}
+
+sub remove_delegation {
+ my $self = shift;
+ my %handles = $self->_canonicalize_handles;
+ my $associated_class = $self->associated_class;
+ foreach my $handle (keys %handles) {
+ $self->associated_class->remove_method($handle);
+ }
}
# private methods to help delegation ...
}
elsif ($handle_type eq 'Regexp') {
($self->has_type_constraint)
- || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
+ || $self->throw_error("Cannot delegate methods based on a RegExpr without a type constraint (isa)", data => $handles);
return map { ($_ => $_) }
grep { /$handles/ } $self->_get_delegate_method_list;
}
return $handles->($self, $self->_find_delegate_metaclass);
}
else {
- confess "Unable to canonicalize the 'handles' option with $handles";
+ $self->throw_error("Unable to canonicalize the 'handles' option with $handles", data => $handles);
}
}
else {
+ Class::MOP::load_class($handles)
+ unless Class::MOP::is_class_loaded($handles);
+
my $role_meta = eval { $handles->meta };
if ($@) {
- confess "Unable to canonicalize the 'handles' option with $handles because : $@";
+ $self->throw_error("Unable to canonicalize the 'handles' option with $handles because : $@", data => $handles, error => $@);
}
(blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
- || confess "Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role";
-
+ || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role", data => $handles);
+
return map { $_ => $_ } (
$role_meta->get_method_list,
$role_meta->get_required_method_list
return $role->meta;
}
else {
- confess "Cannot find delegate metaclass for attribute " . $self->name;
+ $self->throw_error("Cannot find delegate metaclass for attribute " . $self->name);
}
}
my $self = shift;
my $meta = $self->_find_delegate_metaclass;
if ($meta->isa('Class::MOP::Class')) {
- return map { $_->{name} } # NOTE: !never! delegate &meta
- grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' }
- $meta->compute_all_applicable_methods;
+ return map { $_->name } # NOTE: !never! delegate &meta
+ grep { $_->package_name ne 'Moose::Object' && $_->name ne 'meta' }
+ $meta->get_all_methods;
}
elsif ($meta->isa('Moose::Meta::Role')) {
return $meta->get_method_list;
}
else {
- confess "Unable to recognize the delegate metaclass '$meta'";
+ $self->throw_error("Unable to recognize the delegate metaclass '$meta'", data => $meta);
}
}
+sub _make_delegation_method {
+ my ( $self, $handle_name, $method_to_call ) = @_;
+
+ my $method_body;
+
+ $method_body = $method_to_call
+ if 'CODE' eq ref($method_to_call);
+
+ return Moose::Meta::Method::Delegation->new(
+ name => $handle_name,
+ package_name => $self->associated_class->name,
+ attribute => $self,
+ delegate_to_method => $method_to_call,
+ );
+}
+
+package Moose::Meta::Attribute::Custom::Moose;
+sub register_implementation { 'Moose::Meta::Attribute' }
+
1;
__END__
=item B<new>
+=item B<clone>
+
=item B<does>
=item B<initialize_instance_slot>
=item B<install_accessors>
+=item B<remove_accessors>
+
+=item B<install_delegation>
+
+=item B<remove_delegation>
+
=item B<accessor_metaclass>
=item B<get_value>
Before setting the value, a check is made on the type constraint of
the attribute, if it has one, to see if the value passes it. If the
-value fails to pass, the set operation dies with a L<Carp/confess>.
+value fails to pass, the set operation dies with a L<throw_error>.
Any coercion to convert values is done before checking the type constraint.
To check a value against a type constraint before setting it, fetch the
attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
-and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::RecipeX>
+and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::Basics::Recipe4>
for an example.
=back
=over 4
+=item B<throw_error>
+
+Delegates to C<associated_class> or C<Moose::Meta::Class> if there is none.
+
=item B<interpolate_class_and_new>
=item B<interpolate_class>
from a superclass and allows a very specific set of changes to be made
to the attribute.
+=item B<legal_options_for_inheritance>
+
+Whitelist with options you can change. You can overload it in your custom
+metaclass to allow your options be inheritable.
+
=item B<has_type_constraint>
Returns true if this meta-attribute has a type constraint.
#If your attribute name starts with an underscore:
has '_foo' => (lazy_build => 1);
#is the same as
- has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo);
+ has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo');
# or
has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', default => sub{shift->_build__foo});
#If your attribute name does not start with an underscore:
has 'foo' => (lazy_build => 1);
#is the same as
- has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo);
+ has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo');
# or
has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', default => sub{shift->_build_foo});