2 package # hide the package from PAUSE
3 ArrayBasedStorage::Instance;
7 use Scalar::Util qw/refaddr/;
11 our $VERSION = '0.01';
12 my $unbound = \'empty-slot-value';
14 use base 'Class::MOP::Instance';
17 my ($class, $meta, @attrs) = @_;
18 my $self = $class->SUPER::new($meta, @attrs);
20 $self->{'slot_index_map'} = { map { $_ => $index++ } $self->get_all_slots };
26 my $instance = bless [], $self->_class_name;
27 $self->initialize_all_slots($instance);
32 my ($self, $instance) = shift;
33 $self->bless_instance_structure([ @$instance ]);
38 # operations on meta instance
40 sub get_slot_index_map { (shift)->{'slot_index_map'} }
43 my ($self, $instance, $slot_name) = @_;
44 $self->set_slot_value($instance, $slot_name, $unbound);
47 sub deinitialize_slot {
48 my ( $self, $instance, $slot_name ) = @_;
49 $self->set_slot_value($instance, $slot_name, $unbound);
54 return sort $self->SUPER::get_all_slots;
58 my ($self, $instance, $slot_name) = @_;
59 my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ];
60 return $value unless ref $value;
61 refaddr $value eq refaddr $unbound ? undef : $value;
65 my ($self, $instance, $slot_name, $value) = @_;
66 $instance->[ $self->{'slot_index_map'}->{$slot_name} ] = $value;
69 sub is_slot_initialized {
70 my ($self, $instance, $slot_name) = @_;
71 # NOTE: maybe use CLOS's *special-unbound-value* for this?
72 my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ];
73 return 1 unless ref $value;
74 refaddr $value eq refaddr $unbound ? 0 : 1;
77 sub is_dependent_on_superclasses { 1 }
87 ArrayBasedStorage - An example of an Array based instance storage
94 ':instance_metaclass' => 'ArrayBasedStorage::Instance'
97 __PACKAGE__->meta->add_attribute('foo' => (
104 $class->meta->new_object(@_);
107 # now you can just use the class as normal
111 This is a proof of concept using the Instance sub-protocol
112 which uses ARRAY refs to store the instance data.
114 This is very similar now to the InsideOutClass example, and
115 in fact, they both share the exact same test suite, with
116 the only difference being the Instance metaclass they use.
120 Stevan Little E<lt>stevan@iinteractive.comE<gt>
122 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
126 =head1 COPYRIGHT AND LICENSE
128 Copyright 2006-2008 by Infinity Interactive, Inc.
130 L<http://www.iinteractive.com>
132 This library is free software; you can redistribute it and/or modify
133 it under the same terms as Perl itself.