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 sub set_slot_value_weak {
  82     my ($self, $instance, $slot_name, $value) = @_;
  83         $self->set_slot_value($instance, $slot_name, $value);
  84         $self->weaken_slot_value($instance, $slot_name);
  85 }
  86
  87 sub weaken_slot_value {
  88         my ($self, $instance, $slot_name) = @_;
  89         weaken $instance->{$slot_name};
  90 }
  91
  92 sub strengthen_slot_value {
  93         my ($self, $instance, $slot_name) = @_;
  94         $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
  95 }
  96
  97 1;
  98
  99 __END__
 100
 101 =pod
 102
 103 =head1 NAME
 104
 105 Class::MOP::Instance - Instance Meta Object
 106
 107 =head1 SYNOPSIS
 108
 109   # for the most part, this protocol is internal
 110   # and not for public usage, but this how one
 111   # might use it
 112
 113   package Foo;
 114
 115   use strict;
 116   use warnings;
 117   use metaclass 'Class::MOP::Class' => (
 118       ':instance_metaclass'  => 'ArrayBasedStorage::Instance',
 119   );
 120
 121   # now Foo->new produces blessed ARRAY ref based objects
 122
 123 =head1 DESCRIPTION
 124
 125 This is a sub-protocol which governs instance creation
 126 and access to the slots of the instance structure.
 127
 128 This may seem like over-abstraction, but by abstracting
 129 this process into a sub-protocol we make it possible to
 130 easily switch the details of how an object's instance is
 131 stored with minimal impact. In most cases just subclassing
 132 this class will be all you need to do (occasionally it
 133 requires that you also subclass Class::MOP::Attribute if
 134 you require some kind of specific attribute initializations).
 135
 136 =head1 METHODS
 137
 138 =over 4
 139
 140 =item B<new ($meta, @attrs)>
 141
 142 Creates a new instance meta-object and gathers all the slots from
 143 the list of C<@attrs> given.
 144
 145 =item B<meta>
 146
 147 This will return a B<Class::MOP::Class> instance which is related
 148 to this class.
 149
 150 =back
 151
 152 =head2 Creation of Instances
 153
 154 =over 4
 155
 156 =item B<create_instance>
 157
 158 This creates the appropriate structure needed for the instance and
 159 then calls C<bless_instance_structure> to bless it into the class.
 160
 161 =item B<bless_instance_structure ($instance_structure)>
 162
 163 This does just exactly what it says it does.
 164
 165 =back
 166
 167 =head2 Instrospection
 168
 169 NOTE: There might be more methods added to this part of the API,
 170 we will add then when we need them basically.
 171
 172 =over 4
 173
 174 =item B<get_all_slots>
 175
 176 This will return the current list of slots based on what was
 177 given to this object in C<new>.
 178
 179 =back
 180
 181 =head2 Operations on Instance Structures
 182
 183 An important distinction of this sub-protocol is that the
 184 instance meta-object is a different entity from the actual
 185 instance it creates. For this reason, any actions on slots
 186 require that the C<$instance_structure> is passed into them.
 187
 188 =over 4
 189
 190 =item B<get_slot_value ($instance_structure, $slot_name)>
 191
 192 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
 193
 194 =item B<initialize_slot ($instance_structure, $slot_name)>
 195
 196 =item B<initialize_all_slots ($instance_structure)>
 197
 198 =item B<is_slot_initialized ($instance_structure, $slot_name)>
 199
 200 =item B<set_slot_value_weak ($instance_structure, $slot_name, $ref_value)>
 201
 202 =item B<weaken_slot_value>
 203
 204 =item B<strengthen_slot_value>
 205
 206 =back
 207
 208 =head1 AUTHOR
 209
 210 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 211
 212 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 213
 214 =head1 COPYRIGHT AND LICENSE
 215
 216 Copyright 2006 by Infinity Interactive, Inc.
 217
 218 L<http://www.iinteractive.com>
 219
 220 This library is free software; you can redistribute it and/or modify
 221 it under the same terms as Perl itself.
 222
 223 =cut
 224