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 { $_->slots } @attrs;
  20     bless {
  21         # NOTE:
  22         # I am not sure that it makes
  23         # sense to pass in the meta
  24         # The ideal would be to just
  25         # pass in the class name, but
  26         # that is placing too much of
  27         # an assumption on bless(),
  28         # which is *probably* a safe
  29         # assumption,.. but you can
  30         # never tell <:)
  31         meta  => $meta,
  32         slots => \@slots,
  33     } => $class;
  34 }
  35
  36 sub create_instance {
  37     my $self = shift;
  38     $self->bless_instance_structure({});
  39 }
  40
  41 sub bless_instance_structure {
  42     my ($self, $instance_structure) = @_;
  43     bless $instance_structure, $self->{meta}->name;
  44 }
  45
  46 # operations on meta instance
  47
  48 sub get_all_slots {
  49     my $self = shift;
  50     return @{$self->{slots}};
  51 }
  52
  53 # operations on created instances
  54
  55 sub get_slot_value {
  56     my ($self, $instance, $slot_name) = @_;
  57     return $instance->{$slot_name};
  58 }
  59
  60 sub set_slot_value {
  61     my ($self, $instance, $slot_name, $value) = @_;
  62     $instance->{$slot_name} = $value;
  63 }
  64
  65 sub initialize_slot {
  66     my ($self, $instance, $slot_name) = @_;
  67     $instance->{$slot_name} = undef;
  68 }
  69
  70 sub initialize_all_slots {
  71     my ($self, $instance) = @_;
  72     foreach my $slot_name ($self->get_all_slots) {
  73         $self->initialize_slot($instance, $slot_name);
  74     }
  75 }
  76
  77 sub is_slot_initialized {
  78     my ($self, $instance, $slot_name, $value) = @_;
  79     exists $instance->{$slot_name} ? 1 : 0;
  80 }
  81
  82 1;
  83
  84 __END__
  85
  86 =pod
  87
  88 =head1 NAME
  89
  90 Class::MOP::Instance - Instance Meta Object
  91
  92 =head1 SYNOPSIS
  93
  94 =head1 DESCRIPTION
  95
  96 =head1 METHODS
  97
  98 =over 4
  99
 100 =item B<new>
 101
 102 =item B<create_instance>
 103
 104 =item B<bless_instance_structure>
 105
 106 =item B<get_all_slots>
 107
 108 =item B<initialize_all_slots>
 109
 110 =item B<get_slot_value>
 111
 112 =item B<set_slot_value>
 113
 114 =item B<initialize_slot>
 115
 116 =item B<is_slot_initialized>
 117
 118 =back
 119
 120 =head2 Introspection
 121
 122 =over 4
 123
 124 =item B<meta>
 125
 126 This will return a B<Class::MOP::Class> instance which is related
 127 to this class.
 128
 129 =back
 130
 131 =head1 AUTHOR
 132
 133 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 134
 135 =head1 COPYRIGHT AND LICENSE
 136
 137 Copyright 2006 by Infinity Interactive, Inc.
 138
 139 L<http://www.iinteractive.com>
 140
 141 This library is free software; you can redistribute it and/or modify
 142 it under the same terms as Perl itself.
 143
 144 =cut