package # hide the package from PAUSE
- LazyClass;
+ LazyClass::Attribute;
use strict;
use warnings;
-our $VERSION = '0.02';
-
-use base 'Class::MOP::Class';
-
-sub construct_instance {
- my ($class, %params) = @_;
- my $instance = {};
- foreach my $attr ($class->compute_all_applicable_attributes()) {
- # if the attr has an init_arg, use that, otherwise,
- # use the attributes name itself as the init_arg
- my $init_arg = $attr->init_arg();
- # try to fetch the init arg from the %params ...
- my $val;
- $val = $params{$init_arg} if exists $params{$init_arg};
- # now add this to the instance structure
- # only if we have found a value at all
- $instance->{$attr->name} = $val if defined $val;
- }
- return $instance;
+use Carp 'confess';
+
+our $VERSION = '0.05';
+
+use base 'Class::MOP::Attribute';
+
+sub initialize_instance_slot {
+ my ($self, $meta_instance, $instance, $params) = @_;
+
+ # if the attr has an init_arg, use that, otherwise,
+ # use the attributes name itself as the init_arg
+ my $init_arg = $self->init_arg();
+
+ if ( exists $params->{$init_arg} ) {
+ my $val = $params->{$init_arg};
+ $meta_instance->set_slot_value($instance, $self->name, $val);
+ }
}
+sub accessor_metaclass { 'LazyClass::Method::Accessor' }
+
package # hide the package from PAUSE
- LazyClass::Attribute;
+ LazyClass::Method::Accessor;
use strict;
use warnings;
-our $VERSION = '0.02';
+use Carp 'confess';
-use base 'Class::MOP::Attribute';
+our $VERSION = '0.01';
+
+use base 'Class::MOP::Method::Accessor';
sub generate_accessor_method {
- my ($self, $attr_name) = @_;
+ my $attr = (shift)->associated_attribute;
+
+ my $attr_name = $attr->name;
+ my $meta_instance = $attr->associated_class->get_meta_instance;
+
sub {
if (scalar(@_) == 2) {
- $_[0]->{$attr_name} = $_[1];
+ $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
}
else {
- if (!exists $_[0]->{$attr_name}) {
- my $attr = $self->associated_class->get_attribute($attr_name);
- $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;
- }
- $_[0]->{$attr_name};
+ unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
+ my $value = $attr->has_default ? $attr->default($_[0]) : undef;
+ $meta_instance->set_slot_value($_[0], $attr_name, $value);
+ }
+
+ $meta_instance->get_slot_value($_[0], $attr_name);
}
};
}
sub generate_reader_method {
- my ($self, $attr_name) = @_;
+ my $attr = (shift)->associated_attribute;
+
+ my $attr_name = $attr->name;
+ my $meta_instance = $attr->associated_class->get_meta_instance;
+
sub {
- if (!exists $_[0]->{$attr_name}) {
- my $attr = $self->associated_class->get_attribute($attr_name);
- $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;
- }
- $_[0]->{$attr_name};
+ confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+
+ unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
+ my $value = $attr->has_default ? $attr->default($_[0]) : undef;
+ $meta_instance->set_slot_value($_[0], $attr_name, $value);
+ }
+
+ $meta_instance->get_slot_value($_[0], $attr_name);
};
}
+package # hide the package from PAUSE
+ LazyClass::Instance;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+use base 'Class::MOP::Instance';
+
+sub initialize_all_slots {}
+
1;
__END__
package BinaryTree;
- use metaclass 'LazyClass' => (
- ':attribute_metaclass' => 'LazyClass::Attribute'
+ use metaclass (
+ ':attribute_metaclass' => 'LazyClass::Attribute',
+ ':instance_metaclass' => 'LazyClass::Instance',
);
BinaryTree->meta->add_attribute('$:node' => (
default => sub { BinaryTree->new() }
));
- sub new {
+ sub new {
my $class = shift;
- bless $class->meta->construct_instance(@_) => $class;
+ $class->meta->new_object(@_);
}
# ... later in code
ideal for a class which has a large amount of attributes,
several of which are optional.
-=head1 AUTHOR
+=head1 AUTHORS
Stevan Little E<lt>stevan@iinteractive.comE<gt>
+Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
+
=head1 COPYRIGHT AND LICENSE
-Copyright 2006 by Infinity Interactive, Inc.
+Copyright 2006, 2007 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=cut
\ No newline at end of file
+=cut