lib/Class/MOP/Instance.pm

   1
   2 package Class::MOP::Instance;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Scalar::Util 'weaken';
   8
   9 our $VERSION = '0.01';
  10
  11 sub meta {
  12     require Class::MOP::Class;
  13     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
  14 }
  15
  16 sub new {
  17     my ($class, $meta, @attrs) = @_;
  18     my @slots = map { $_->slots } @attrs;
  19     bless {
  20         # NOTE:
  21         # I am not sure that it makes
  22         # sense to pass in the meta
  23         # The ideal would be to just
  24         # pass in the class name, but
  25         # that is placing too much of
  26         # an assumption on bless(),
  27         # which is *probably* a safe
  28         # assumption,.. but you can
  29         # never tell <:)
  30         meta  => $meta,
  31         slots => \@slots,
  32     } => $class;
  33 }
  34
  35 sub create_instance {
  36     my $self = shift;
  37     $self->bless_instance_structure({});
  38 }
  39
  40 sub bless_instance_structure {
  41     my ($self, $instance_structure) = @_;
  42     bless $instance_structure, $self->{meta}->name;
  43 }
  44
  45 # operations on meta instance
  46
  47 sub get_all_slots {
  48     my $self = shift;
  49     return @{$self->{slots}};
  50 }
  51
  52 # operations on created instances
  53
  54 sub get_slot_value {
  55     my ($self, $instance, $slot_name) = @_;
  56     return $instance->{$slot_name};
  57 }
  58
  59 sub set_slot_value {
  60     my ($self, $instance, $slot_name, $value) = @_;
  61     $instance->{$slot_name} = $value;
  62 }
  63
  64 sub initialize_slot {
  65     my ($self, $instance, $slot_name) = @_;
  66     $instance->{$slot_name} = undef;
  67 }
  68
  69 sub initialize_all_slots {
  70     my ($self, $instance) = @_;
  71     foreach my $slot_name ($self->get_all_slots) {
  72         $self->initialize_slot($instance, $slot_name);
  73     }
  74 }
  75
  76 sub is_slot_initialized {
  77     my ($self, $instance, $slot_name, $value) = @_;
  78     exists $instance->{$slot_name} ? 1 : 0;
  79 }
  80
  81 1;
  82
  83 __END__
  84
  85 =pod
  86
  87 =head1 NAME
  88
  89 Class::MOP::Instance - Instance Meta Object
  90
  91 =head1 SYNOPSIS
  92
  93   # for the most part, this protocol is internal
  94   # and not for public usage, but this how one
  95   # might use it
  96
  97   package Foo;
  98
  99   use strict;
 100   use warnings;
 101   use metaclass 'Class::MOP::Class' => (
 102       ':instance_metaclass'  => 'ArrayBasedStorage::Instance',
 103   );
 104
 105   # now Foo->new produces blessed ARRAY ref based objects
 106
 107 =head1 DESCRIPTION
 108
 109 This is a sub-protocol which governs instance creation
 110 and access to the slots of the instance structure.
 111
 112 This may seem like over-abstraction, but by abstracting
 113 this process into a sub-protocol we make it possible to
 114 easily switch the details of how an object's instance is
 115 stored with minimal impact. In most cases just subclassing
 116 this class will be all you need to do (occasionally it
 117 requires that you also subclass Class::MOP::Attribute if
 118 you require some kind of specific attribute initializations).
 119
 120 =head1 METHODS
 121
 122 =over 4
 123
 124 =item B<new ($meta, @attrs)>
 125
 126 Creates a new instance meta-object and gathers all the slots from
 127 the list of C<@attrs> given.
 128
 129 =item B<meta>
 130
 131 This will return a B<Class::MOP::Class> instance which is related
 132 to this class.
 133
 134 =back
 135
 136 =head2 Creation of Instances
 137
 138 =over 4
 139
 140 =item B<create_instance>
 141
 142 This creates the appropriate structure needed for the instance and
 143 then calls C<bless_instance_structure> to bless it into the class.
 144
 145 =item B<bless_instance_structure ($instance_structure)>
 146
 147 This does just exactly what it says it does.
 148
 149 =back
 150
 151 =head2 Instrospection
 152
 153 NOTE: There might be more methods added to this part of the API,
 154 we will add then when we need them basically.
 155
 156 =over 4
 157
 158 =item B<get_all_slots>
 159
 160 This will return the current list of slots based on what was
 161 given to this object in C<new>.
 162
 163 =back
 164
 165 =head2 Operations on Instance Structures
 166
 167 An important distinction of this sub-protocol is that the
 168 instance meta-object is a different entity from the actual
 169 instance it creates. For this reason, any actions on slots
 170 require that the C<$instance_structure> is passed into them.
 171
 172 =over 4
 173
 174 =item B<get_slot_value ($instance_structure, $slot_name)>
 175
 176 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
 177
 178 =item B<initialize_slot ($instance_structure, $slot_name)>
 179
 180 =item B<initialize_all_slots ($instance_structure)>
 181
 182 =item B<is_slot_initialized ($instance_structure, $slot_name)>
 183
 184 =back
 185
 186 =head1 AUTHOR
 187
 188 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 189
 190 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 191
 192 =head1 COPYRIGHT AND LICENSE
 193
 194 Copyright 2006 by Infinity Interactive, Inc.
 195
 196 L<http://www.iinteractive.com>
 197
 198 This library is free software; you can redistribute it and/or modify
 199 it under the same terms as Perl itself.
 200
 201 =cut