lib/Class/MOP/Instance.pm

   1
   2 package Class::MOP::Instance;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed', 'reftype', 'weaken';
   9
  10 our $VERSION = '0.01';
  11
  12 sub meta {
  13     require Class::MOP::Class;
  14     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
  15 }
  16
  17 sub new {
  18     my ($class, $meta, @attrs) = @_;
  19     my @slots = map { $_->name } @attrs;
  20     bless {
  21         meta  => $meta,
  22         slots => \@slots,
  23     } => $class;
  24 }
  25
  26 sub create_instance {
  27     my $self = shift;
  28     $self->bless_instance_structure({});
  29 }
  30
  31 sub bless_instance_structure {
  32     my ($self, $instance_structure) = @_;
  33     bless $instance_structure, $self->{meta}->name;
  34 }
  35
  36 # operations on meta instance
  37
  38 sub get_all_slots {
  39     my $self = shift;
  40     return @{$self->{slots}};
  41 }
  42
  43 # operations on created instances
  44
  45 sub get_slot_value {
  46     my ($self, $instance, $slot_name) = @_;
  47     return $instance->{$slot_name};
  48 }
  49
  50 sub set_slot_value {
  51     my ($self, $instance, $slot_name, $value) = @_;
  52     $instance->{$slot_name} = $value;
  53 }
  54
  55 sub initialize_slot {
  56     my ($self, $instance, $slot_name) = @_;
  57     $instance->{$slot_name} = undef;
  58 }
  59
  60 sub is_slot_initialized {
  61     my ($self, $instance, $slot_name, $value) = @_;
  62     exists $instance->{$slot_name} ? 1 : 0;
  63 }
  64
  65 # inlinable operation snippets
  66
  67 sub inline_get_slot_value {
  68     my ($self, $instance_var_name, $slot_name) = @_;
  69     return ($instance_var_name . '->{\'' . $slot_name . '\'}');
  70 }
  71
  72 sub inline_set_slot_value {
  73     my ($self, $instance_var_name, $slot_name, $value_name) = @_;
  74     return ($self->inline_get_slot_value($instance_var_name, $slot_name) . ' = ' . $value_name);
  75 }
  76
  77 sub inline_initialize_slot {
  78     my ($self, $instance_var_name, $slot_name) = @_;
  79     $self->inline_set_slot_value($instance_var_name, $slot_name, 'undef');
  80 }
  81
  82 sub inline_is_slot_initialized {
  83     my ($self, $instance_var_name, $slot_name) = @_;
  84     return ('exists ' . $self->inline_get_slot_value($instance_var_name, $slot_name) . ' ? 1 : 0');
  85 }
  86
  87 1;
  88
  89 __END__
  90
  91 =pod
  92
  93 =head1 NAME
  94
  95 Class::MOP::Instance - Instance Meta Object
  96
  97 =head1 SYNOPSIS
  98
  99 =head1 DESCRIPTION
 100
 101 =head1 METHODS
 102
 103 =over 4
 104
 105 =item B<new>
 106
 107 =item B<bless_instance_structure>
 108
 109 =item B<compute_layout_from_class>
 110
 111 =item B<create_instance>
 112
 113 =item B<get_all_slots>
 114
 115 =item B<get_slot_value>
 116
 117 =item B<set_slot_value>
 118
 119 =item B<initialize_slot>
 120
 121 =item B<is_slot_initialized>
 122
 123 =item B<inline_get_slot_value>
 124
 125 =item B<inline_set_slot_value>
 126
 127 =item B<inline_initialize_slot>
 128
 129 =item B<inline_is_slot_initialized>
 130
 131 =back
 132
 133 =head2 Introspection
 134
 135 =over 4
 136
 137 =item B<meta>
 138
 139 This will return a B<Class::MOP::Class> instance which is related
 140 to this class.
 141
 142 =back
 143
 144 =head1 AUTHOR
 145
 146 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 147
 148 =head1 COPYRIGHT AND LICENSE
 149
 150 Copyright 2006 by Infinity Interactive, Inc.
 151
 152 L<http://www.iinteractive.com>
 153
 154 This library is free software; you can redistribute it and/or modify
 155 it under the same terms as Perl itself.
 156
 157 =cut