X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=examples%2FLazyClass.pod;h=839b609f6a9c86c6ec07b187914e203e2b7ec715;hb=c0fcd6ab4d6e37bb8c1b1f39f130a80ae9e419dc;hp=cb678b14e49b8a1bd884058fa195dbdc396a5d10;hpb=c9e77dbb017258dc44295fc4ec8e0bdd99ec9361;p=gitmo%2FClass-MOP.git diff --git a/examples/LazyClass.pod b/examples/LazyClass.pod index cb678b1..839b609 100644 --- a/examples/LazyClass.pod +++ b/examples/LazyClass.pod @@ -1,68 +1,94 @@ 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->has_init_arg() ? $attr->init_arg() : $attr->name; - # 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__ @@ -77,8 +103,9 @@ LazyClass - An example metaclass with lazy initialization package BinaryTree; - use metaclass 'LazyClass' => ( - ':attribute_metaclass' => 'LazyClass::Attribute' + use metaclass ( + ':attribute_metaclass' => 'LazyClass::Attribute', + ':instance_metaclass' => 'LazyClass::Instance', ); BinaryTree->meta->add_attribute('$:node' => ( @@ -96,9 +123,9 @@ LazyClass - An example metaclass with lazy initialization default => sub { BinaryTree->new() } )); - sub new { + sub new { my $class = shift; - bless $class->meta->construct_instance(@_) => $class; + $class->meta->new_object(@_); } # ... later in code @@ -118,17 +145,19 @@ 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. +Copyright 2006, 2007 by Infinity Interactive, Inc. 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