2 package # hide the package from PAUSE
3 ArrayBasedStorage::Attribute;
10 our $VERSION = '0.01';
12 use base 'Class::MOP::Attribute';
14 sub generate_accessor_method {
16 my $attr_name = $self->name;
18 my $meta_instance = $_[0]->meta->get_meta_instance;
19 $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2;
20 $meta_instance->get_slot_value($_[0], $attr_name);
24 sub generate_reader_method {
26 my $attr_name = $self->name;
28 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
31 ->get_slot_value($_[0], $attr_name);
35 sub generate_writer_method {
37 my $attr_name = $self->name;
41 ->set_slot_value($_[0], $attr_name, $_[1]);
45 sub generate_predicate_method {
47 my $attr_name = $self->name;
51 ->get_slot_value($_[0], $attr_name) ? 1 : 0;
55 package # hide the package from PAUSE
56 ArrayBasedStorage::Instance;
63 our $VERSION = '0.01';
65 use base 'Class::MOP::Instance';
68 my ($class, $meta, @attrs) = @_;
69 my $self = $class->SUPER::new($meta, @attrs);
71 $self->{slot_index_map} = { map { $_ => $index++ } $self->get_all_slots };
77 $self->bless_instance_structure([]);
80 # operations on meta instance
84 return sort @{$self->{slots}};
88 my ($self, $instance, $slot_name) = @_;
89 return $instance->[ $self->{slot_index_map}->{$slot_name} ];
93 my ($self, $instance, $slot_name, $value) = @_;
94 $instance->[ $self->{slot_index_map}->{$slot_name} ] = $value;
98 my ($self, $instance, $slot_name) = @_;
99 $instance->[ $self->{slot_index_map}->{$slot_name} ] = undef;
102 sub is_slot_initialized {
104 # maybe use CLOS's *special-unbound-value*
106 confess "Cannot really tell this for sure";
117 ArrayBasedStorage - An example of an Array based instance storage
123 use metaclass 'Class::MOP::Class' => (
124 ':attribute_metaclass' => 'ArrayBasedStorage::Attribute'
125 ':instance_metaclass' => 'ArrayBasedStorage::Instance'
128 __PACKAGE__->meta->add_attribute('foo' => (
135 $class->meta->new_object(@_);
138 # now you can just use the class as normal
142 This is a proof of concept using the Instance sub-protocol
143 which uses ARRAY refs to store the instance data.
147 Stevan Little E<lt>stevan@iinteractive.comE<gt>
151 =head1 COPYRIGHT AND LICENSE
153 Copyright 2006 by Infinity Interactive, Inc.
155 L<http://www.iinteractive.com>
157 This library is free software; you can redistribute it and/or modify
158 it under the same terms as Perl itself.