X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=examples%2FLazyClass.pod;h=7c9d00a311c68f39136f801bda49092bbbd2fcca;hb=8203616d0be984d3ca70ee863e75ee3784f894e5;hp=184793986b4c1551524b7c33b893ec8fc824bf6b;hpb=839ea97307cde7e936bff72d3f76d6213b9883a9;p=gitmo%2FClass-MOP.git diff --git a/examples/LazyClass.pod b/examples/LazyClass.pod index 1847939..7c9d00a 100644 --- a/examples/LazyClass.pod +++ b/examples/LazyClass.pod @@ -7,52 +7,88 @@ use warnings; use Carp 'confess'; -our $VERSION = '0.03'; +our $VERSION = '0.05'; use base 'Class::MOP::Attribute'; sub initialize_instance_slot { - my ($self, $class, $meta_instance, $params) = @_; + 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(); - # 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 - $meta_instance->add_slot($self->name, $val) if defined $val; + + 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::Method::Accessor; + +use strict; +use warnings; + +use Carp 'confess'; + +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 { confess "Cannot assign a value to a read-only accessor" if @_ > 1; - 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); }; } +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__ @@ -67,8 +103,9 @@ LazyClass - An example metaclass with lazy initialization package BinaryTree; - use metaclass 'Class::MOP::Class' => ( - ':attribute_metaclass' => 'LazyClass::Attribute' + use metaclass ( + ':attribute_metaclass' => 'LazyClass::Attribute', + ':instance_metaclass' => 'LazyClass::Instance', ); BinaryTree->meta->add_attribute('$:node' => ( @@ -108,10 +145,12 @@ without complicating the programing of it. This would also be ideal for a class which has a large amount of attributes, several of which are optional. -=head1 AUTHOR +=head1 AUTHORS Stevan Little Estevan@iinteractive.comE +Yuval Kogman Enothingmuch@woobling.comE + =head1 COPYRIGHT AND LICENSE Copyright 2006 by Infinity Interactive, Inc. @@ -121,4 +160,4 @@ L 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