examples/ArrayBasedStorage.pod

   1
   2 package # hide the package from PAUSE
   3     ArrayBasedStorage::Instance;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Carp 'confess';
   9
  10 our $VERSION = '0.01';
  11
  12 use base 'Class::MOP::Instance';
  13
  14 sub new {
  15     my ($class, $meta, @attrs) = @_;
  16     my $self = $class->SUPER::new($meta, @attrs);
  17     my $index = 0;
  18     $self->{slot_index_map} = { map { $_ => $index++ } $self->get_all_slots };
  19     return $self;
  20 }
  21
  22 sub create_instance {
  23     my $self = shift;
  24     $self->bless_instance_structure([]);
  25 }
  26
  27 sub clone_instance {
  28     my ($self, $instance) = shift;
  29     $self->bless_instance_structure([ @$instance ]);
  30 }
  31
  32 # operations on meta instance
  33
  34 sub get_slot_index_map { (shift)->{slot_index_map} }
  35
  36 sub get_all_slots {
  37     my $self = shift;
  38     return sort $self->SUPER::get_all_slots;
  39 }
  40
  41 sub get_slot_value {
  42     my ($self, $instance, $slot_name) = @_;
  43     return $instance->[ $self->{slot_index_map}->{$slot_name} ];
  44 }
  45
  46 sub set_slot_value {
  47     my ($self, $instance, $slot_name, $value) = @_;
  48     $instance->[ $self->{slot_index_map}->{$slot_name} ] = $value;
  49 }
  50
  51 sub is_slot_initialized {
  52     # NOTE:
  53     # maybe use CLOS's *special-unbound-value*
  54     # for this ?
  55     confess "Cannot really tell this for sure";
  56 }
  57
  58 1;
  59
  60 __END__
  61
  62 =pod
  63
  64 =head1 NAME
  65
  66 ArrayBasedStorage - An example of an Array based instance storage
  67
  68 =head1 SYNOPSIS
  69
  70   package Foo;
  71
  72   use metaclass (
  73     ':instance_metaclass'  => 'ArrayBasedStorage::Instance'
  74   );
  75
  76   __PACKAGE__->meta->add_attribute('foo' => (
  77       reader => 'get_foo',
  78       writer => 'set_foo'
  79   ));
  80
  81   sub new  {
  82       my $class = shift;
  83       $class->meta->new_object(@_);
  84   }
  85
  86   # now you can just use the class as normal
  87
  88 =head1 DESCRIPTION
  89
  90 This is a proof of concept using the Instance sub-protocol
  91 which uses ARRAY refs to store the instance data.
  92
  93 This is very similar now to the InsideOutClass example, and
  94 in fact, they both share the exact same test suite, with
  95 the only difference being the Instance metaclass they use.
  96
  97 =head1 AUTHORS
  98
  99 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 100
 101 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 102
 103 =head1 SEE ALSO
 104
 105 =head1 COPYRIGHT AND LICENSE
 106
 107 Copyright 2006 by Infinity Interactive, Inc.
 108
 109 L<http://www.iinteractive.com>
 110
 111 This library is free software; you can redistribute it and/or modify
 112 it under the same terms as Perl itself.
 113
 114 =cut