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 ]);
36 # operations on meta instance
38 sub get_slot_index_map { (shift)->{'slot_index_map'} }
41 my ($self, $instance, $slot_name) = @_;
42 $self->set_slot_value($instance, $slot_name, $unbound);
45 sub deinitialize_slot {
46 my ( $self, $instance, $slot_name ) = @_;
47 $self->set_slot_value($instance, $slot_name, $unbound);
52 return sort $self->SUPER::get_all_slots;
56 my ($self, $instance, $slot_name) = @_;
57 my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ];
58 return $value unless ref $value;
59 refaddr $value eq refaddr $unbound ? undef : $value;
63 my ($self, $instance, $slot_name, $value) = @_;
64 $instance->[ $self->{'slot_index_map'}->{$slot_name} ] = $value;
67 sub is_slot_initialized {
68 my ($self, $instance, $slot_name) = @_;
69 # NOTE: maybe use CLOS's *special-unbound-value* for this?
70 my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ];
71 return 1 unless ref $value;
72 refaddr $value eq refaddr $unbound ? 0 : 1;
75 sub is_dependent_on_superclasses { 1 }
85 ArrayBasedStorage - An example of an Array based instance storage
92 ':instance_metaclass' => 'ArrayBasedStorage::Instance'
95 __PACKAGE__->meta->add_attribute('foo' => (
102 $class->meta->new_object(@_);
105 # now you can just use the class as normal
109 This is a proof of concept using the Instance sub-protocol
110 which uses ARRAY refs to store the instance data.
112 This is very similar now to the InsideOutClass example, and
113 in fact, they both share the exact same test suite, with
114 the only difference being the Instance metaclass they use.
118 Stevan Little E<lt>stevan@iinteractive.comE<gt>
120 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
124 =head1 COPYRIGHT AND LICENSE
126 Copyright 2006-2008 by Infinity Interactive, Inc.
128 L<http://www.iinteractive.com>
130 This library is free software; you can redistribute it and/or modify
131 it under the same terms as Perl itself.