2 package # hide the package from PAUSE
3 ArrayBasedInstance::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 = $self->associated_class->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;
29 my $meta_instance = $self->associated_class->get_meta_instance;
30 $meta_instance->get_slot_value($_[0], $attr_name);
34 sub generate_writer_method {
36 my $attr_name = $self->name;
38 my $meta_instance = $self->associated_class->get_meta_instance;
39 $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
43 sub generate_predicate_method {
45 my $attr_name = $self->name;
47 my $meta_instance = $self->associated_class->get_meta_instance;
48 defined $meta_instance->get_slot_value($_[0], $attr_name) ? 1 : 0;
52 package # hide the package from PAUSE
53 ArrayBasedInstance::Instance;
60 our $VERSION = '0.01';
62 use base 'Class::MOP::Instance';
65 my ($class, $meta, @attrs) = @_;
66 my $self = $class->SUPER::new($meta, @attrs);
68 $self->{slot_index_map} = { map { $_ => $index++ } $self->get_all_slots };
74 $self->bless_instance_structure([]);
77 # operations on meta instance
81 return sort @{$self->{slots}};
85 my ($self, $instance, $slot_name) = @_;
86 return $instance->[ $self->{slot_index_map}->{$slot_name} ];
90 my ($self, $instance, $slot_name, $value) = @_;
91 $instance->[ $self->{slot_index_map}->{$slot_name} ] = $value;
95 my ($self, $instance, $slot_name) = @_;
96 $instance->[ $self->{slot_index_map}->{$slot_name} ] = undef;
99 sub is_slot_initialized {
101 # maybe use CLOS's *special-unbound-value*
103 confess "Cannot really tell this for sure";
114 ArrayBasedInstance - An example of an Array based instance
122 Stevan Little E<lt>stevan@iinteractive.comE<gt>
126 =head1 COPYRIGHT AND LICENSE
128 Copyright 2006 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.