X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=examples%2FAttributesWithHistory.pod;h=3d2128187dfed5735ca30836e31e85d7534c814f;hb=56e8dd5d8cb94bc16d5f663e436aa41178b0dc7d;hp=50f855bbde0b4279564f7c10a7fe35c5722883d3;hpb=aa448b163f4882fc3e4b92a1c1f22e3c9ad9f933;p=gitmo%2FClass-MOP.git diff --git a/examples/AttributesWithHistory.pod b/examples/AttributesWithHistory.pod index 50f855b..3d21281 100644 --- a/examples/AttributesWithHistory.pod +++ b/examples/AttributesWithHistory.pod @@ -5,36 +5,35 @@ package # hide the package from PAUSE use strict; use warnings; -our $VERSION = '0.02'; +our $VERSION = '0.04'; use base 'Class::MOP::Attribute'; # this is for an extra attribute constructor # option, which is to be able to create a # way for the class to access the history -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('history_accessor' => ( - reader => 'history_accessor', - init_arg => 'history_accessor', - predicate => 'has_history_accessor', - )) -); +AttributesWithHistory->meta->add_attribute('history_accessor' => ( + reader => 'history_accessor', + init_arg => 'history_accessor', + predicate => 'has_history_accessor', +)); # this is a place to store the actual # history of the attribute -__PACKAGE__->meta->add_attribute( - Class::MOP::Attribute->new('_history' => ( - accessor => '_history', - default => sub { [] }, - )) -); +AttributesWithHistory->meta->add_attribute('_history' => ( + accessor => '_history', + default => sub { {} }, +)); # generate the methods sub generate_history_accessor_method { my ($self, $attr_name) = @_; eval qq{sub { - \@\{\$_[0]->meta->get_attribute('$attr_name')->_history()\}; + unless (ref \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}) \{ + \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\} = []; + \} + \@\{\$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}\}; }}; } @@ -42,7 +41,10 @@ sub generate_accessor_method { my ($self, $attr_name) = @_; eval qq{sub { if (scalar(\@_) == 2) { - push \@\{\$_[0]->meta->get_attribute('$attr_name')->_history()\} => \$_[1]; + unless (ref \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}) \{ + \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\} = []; + \} + push \@\{\$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}\} => \$_[1]; \$_[0]->{'$attr_name'} = \$_[1]; } \$_[0]->{'$attr_name'}; @@ -52,21 +54,21 @@ sub generate_accessor_method { sub generate_writer_method { my ($self, $attr_name) = @_; eval qq{sub { - push \@\{\$_[0]->meta->get_attribute('$attr_name')->_history()\} => \$_[1]; + unless (ref \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}) \{ + \$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\} = []; + \} + push \@\{\$_[0]->meta->get_attribute('$attr_name')->_history()->\{\$_[0]\}\} => \$_[1]; \$_[0]->{'$attr_name'} = \$_[1]; }}; } -sub install_accessors { - my $self = shift; - # do as we normall do ... - $self->SUPER::install_accessors(); +AttributesWithHistory->meta->add_after_method_modifier('install_accessors' => sub { + my ($self) = @_; # and now add the history accessor $self->associated_class->add_method( $self->process_accessors('history_accessor' => $self->history_accessor()) ) if $self->has_history_accessor(); - return; -} +}); 1; @@ -104,10 +106,12 @@ history as a field in the attribute meta-object, and will autogenerate a means of accessing that history for the class which these attributes are added too. -=head1 AUTHOR +=head1 AUTHORS Stevan Little Estevan@iinteractive.comE +Yuval Kogman Enothingmuch@woobling.comE + =head1 COPYRIGHT AND LICENSE Copyright 2006 by Infinity Interactive, Inc.