use warnings;
use Class::MOP::Method::Accessor;
+use Class::MOP::Method::Reader;
+use Class::MOP::Method::Writer;
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.78';
+our $VERSION = '0.94';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
my $name = $options{name};
- (defined $name && $name)
+ (defined $name)
|| confess "You must provide a name for the attribute";
$options{init_arg} = $name
sub _new {
my $class = shift;
+
+ return Class::MOP::Class->initialize($class)->new_object(@_)
+ if $class ne __PACKAGE__;
+
my $options = @_ == 1 ? $_[0] : {@_};
bless {
'default' => $options->{default},
'initializer' => $options->{initializer},
'definition_context' => $options->{definition_context},
+ 'lazy' => $options->{lazy},
# keep a weakened link to the
# class we are associated with
'associated_class' => undef,
# and a list of the methods
# associated with this attr
'associated_methods' => [],
+ # this let's us keep track of
+ # our order inside the associated
+ # class
+ 'insertion_order' => undef,
}, $class;
}
return bless { %{$self}, %options } => ref($self);
}
+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,
+ );
+}
+
sub initialize_instance_slot {
my ($self, $meta_instance, $instance, $params) = @_;
my $init_arg = $self->{'init_arg'};
+ my ($val, $value_is_set);
# try to fetch the init arg from the %params ...
# if nothing was in the %params, we can use the
# attribute's default value (if it has one)
if(defined $init_arg and exists $params->{$init_arg}){
- $self->_set_initial_slot_value(
- $meta_instance,
- $instance,
- $params->{$init_arg},
- );
- }
- elsif (defined $self->{'default'}) {
- $self->_set_initial_slot_value(
- $meta_instance,
- $instance,
- $self->default($instance),
- );
- }
- elsif (defined( my $builder = $self->{'builder'})) {
- if ($builder = $instance->can($builder)) {
- $self->_set_initial_slot_value(
- $meta_instance,
- $instance,
- $instance->$builder,
- );
- }
- else {
- confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
+ $val = $params->{$init_arg};
+ $value_is_set = 1;
+ } else {
+ return if $self->is_lazy;
+
+ if($self->has_default){
+ $val = $self->default($instance);
+ $value_is_set = 1;
+ } elsif($self->has_builder){
+ $val = $self->_call_builder($instance);
+ $value_is_set = 1;
}
}
+
+ return unless $value_is_set;
+
+ $self->_set_initial_slot_value(
+ $meta_instance,
+ $instance,
+ $val,
+ );
+
}
sub _set_initial_slot_value {
sub has_init_arg { defined($_[0]->{'init_arg'}) }
sub has_default { defined($_[0]->{'default'}) }
sub has_initializer { defined($_[0]->{'initializer'}) }
+sub has_insertion_order { defined($_[0]->{'insertion_order'}) }
sub accessor { $_[0]->{'accessor'} }
sub reader { $_[0]->{'reader'} }
sub init_arg { $_[0]->{'init_arg'} }
sub initializer { $_[0]->{'initializer'} }
sub definition_context { $_[0]->{'definition_context'} }
+sub insertion_order { $_[0]->{'insertion_order'} }
+sub _set_insertion_order { $_[0]->{'insertion_order'} = $_[1] }
+sub is_lazy { $_[0]->{'lazy'} }
# end bootstrapped away method section.
# (all methods below here are kept intact)
}
sub is_default_a_coderef {
- ('CODE' eq ref($_[0]->{'default'}))
+ my ($value) = $_[0]->{'default'};
+ return unless ref($value);
+ return ref($value) eq 'CODE' || (blessed($value) && $value->isa('Class::MOP::Method'));
}
sub default {
);
}
-sub set_value {
+sub set_value { shift->set_raw_value(@_) }
+sub get_value { shift->get_raw_value(@_) }
+
+sub set_raw_value {
my ($self, $instance, $value) = @_;
Class::MOP::Class->initialize(ref($instance))
->set_slot_value($instance, $self->name, $value);
}
-sub get_value {
+sub get_raw_value {
my ($self, $instance) = @_;
+ if($self->is_lazy && !$self->has_value($instance)){
+ my $val;
+
+ if($self->has_default){
+ $val = $self->default($instance);
+ } elsif($self->has_builder){
+ $val = $self->_call_builder($instance);
+ }
+
+ $self->set_initial_value(
+ $instance,
+ $val,
+ );
+ }
+
Class::MOP::Class->initialize(ref($instance))
->get_meta_instance
->get_slot_value($instance, $self->name);
## load em up ...
sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
-
-sub process_accessors {
- warn "The process_accessors method has been made private and this public alias will be removed in a future release.";
- goto &_process_accessors;
+sub method_metaclasses {
+ {
+ reader => 'Class::MOP::Method::Reader',
+ writer => 'Class::MOP::Method::Writer',
+ }
}
sub _process_accessors {
$method_ctx->{description} = $desc;
}
- $method = $self->accessor_metaclass->new(
+ my $method_metaclass = $self->method_metaclasses->{$type} || $self->accessor_metaclass;
+
+ $method = $method_metaclass->new(
attribute => $self,
is_inline => $inline_me,
accessor_type => $type,
}
my $method = $class->get_method($accessor);
$class->remove_method($accessor)
- if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
+ if (ref($method) && $method->isa('Class::MOP::Method::Attribute'));
};
sub remove_accessors {
=over 8
-=item I<init_arg>
+=item * init_arg
This is a string value representing the expected key in an
initialization hash. For instance, if we have an C<init_arg> value of
C<-foo>, then the following code will Just Work.
- MyClass->meta->construct_instance( -foo => 'Hello There' );
+ MyClass->meta->new_object( -foo => 'Hello There' );
If an init_arg is not assigned, it will automatically use the
attribute's name. If C<init_arg> is explicitly set to C<undef>, the
attribute cannot be specified during initialization.
-=item I<builder>
+=item * builder
This provides the name of a method that will be called to initialize
the attribute. This method will be called on the object after it is
constructed. It is expected to return a valid value for the attribute.
-=item I<default>
+=item * default
This can be used to provide an explicit default for initializing the
attribute. If the default you provide is a subroutine reference, then
particular order, so you cannot rely on the value of some other
attribute when generating the default.
-=item I<initializer>
+=item * initializer
This option can be either a method name or a subroutine
reference. This method will be called when setting the attribute's
Class::MOP::Attribute->new(
'doubled' => (
initializer => sub {
- my ( $instance, $value, $set ) = @_;
+ my ( $self, $value, $set, $attr ) = @_;
$set->( $value * 2 );
},
)
should be a subroutine reference, which will be installed as the
method itself.
-=over 4
+=over 8
-=item I<accessor>
+=item * accessor
An C<accessor> is a standard Perl-style read/write accessor. It will
return the value of the attribute, and if a value is passed as an
$object->set_something(undef);
-=item I<reader>
+=item * reader
This is a basic read-only accessor. It returns the value of the
attribute.
-=item I<writer>
+=item * writer
This is a basic write accessor, it accepts a single argument, and
assigns that value to the attribute.
$object->set_something(undef);
-=item I<predicate>
+=item * predicate
The predicate method returns a boolean indicating whether or not the
attribute has been explicitly set.
Note that the predicate returns true even if the attribute was set to
a false value (C<0> or C<undef>).
-=item I<clearer>
+=item * clearer
This method will uninitialize the attribute. After an attribute is
cleared, its C<predicate> will return false.
-=item I<definition_context>
+=item * definition_context
Mostly, this exists as a hook for the benefit of Moose.
=item B<< $attr->name >>
+Returns the attribute's name.
+
=item B<< $attr->accessor >>
=item B<< $attr->reader >>
always return a subroutine reference, regardless of whether or not the
attribute is read- or write-only.
+=item B<< $attr->insertion_order >>
+
+If this attribute has been inserted into a class, this returns a zero
+based index regarding the order of insertion.
+
=back
=head2 Informational predicates
=item B<< $attr->has_builder >>
+=item B<< $attr->has_insertion_order >>
+
+This will be I<false> if this attribute has not be inserted into a class
+
=back
=head2 Value management
Sets the value without going through the accessor. Note that this
works even with read-only attributes.
+=item B<< $attr->set_raw_value($instance, $value) >>
+
+Sets the value with no side effects such as a trigger.
+
+This doesn't actually apply to Class::MOP attributes, only to subclasses.
+
=item B<< $attr->set_initial_value($instance, $value) >>
Sets the value without going through the accessor. This method is only
Returns the value without going through the accessor. Note that this
works even with write-only accessors.
+=item B<< $sttr->get_raw_value($instance) >>
+
+Returns the value without any side effects such as lazy attributes.
+
+Doesn't actually apply to Class::MOP attributes, only to subclasses.
+
=item B<< $attr->has_value($instance) >>
Return a boolean indicating whether the attribute has been set in
=over 4
-=item B<< $attr->meta >>
+=item B<< Class::MOP::Attribute->meta >>
This will return a L<Class::MOP::Class> instance for this class.