slotnames

[gitmo/Class-MOP.git] / lib / Class / MOP / Instance.pm

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 7d1e573..d7bb7fb 100644 (file)
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -15,19 +15,84 @@ sub meta {
 }
 
 sub new { 
-    my $class = shift;
-    my $meta  = shift;
+    my ($class, $meta, @attrs) = @_;
+    my @slots = map { $_->slots } @attrs;
     bless {
-        instance => bless {} => $meta->name
+        # NOTE:
+        # I am not sure that it makes
+        # sense to pass in the meta
+        # The ideal would be to just 
+        # pass in the class name, but 
+        # that is placing too much of 
+        # an assumption on bless(), 
+        # which is *probably* a safe
+        # assumption,.. but you can 
+        # never tell <:)
+        meta  => $meta,
+        slots => \@slots,
     } => $class; 
 }
 
-sub add_slot {
-    my ($self, $slot_name, $value) = @_;
-    return $self->{instance}->{$slot_name} = $value;
+sub create_instance {
+    my $self = shift;
+    $self->bless_instance_structure({});
 }
 
-sub get_instance { (shift)->{instance} }
+sub bless_instance_structure {
+    my ($self, $instance_structure) = @_;
+    bless $instance_structure, $self->{meta}->name;
+}
+
+# operations on meta instance
+
+sub get_all_slots {
+    my $self = shift;
+    return @{$self->{slots}};
+}
+
+# operations on created instances
+
+sub get_slot_value {
+    my ($self, $instance, $slot_name) = @_;
+    return $instance->{$slot_name};
+}
+
+sub set_slot_value {
+    my ($self, $instance, $slot_name, $value) = @_;
+    $instance->{$slot_name} = $value;
+}
+
+sub initialize_slot {
+    my ($self, $instance, $slot_name) = @_;
+    $instance->{$slot_name} = undef;
+}
+
+sub is_slot_initialized {
+    my ($self, $instance, $slot_name, $value) = @_;
+    exists $instance->{$slot_name} ? 1 : 0;
+}
+
+# inlinable operation snippets
+
+sub inline_get_slot_value {
+    my ($self, $instance_var_name, $slot_name) = @_;
+    return ($instance_var_name . '->{\'' . $slot_name . '\'}');
+}
+
+sub inline_set_slot_value {
+    my ($self, $instance_var_name, $slot_name, $value_name) = @_;
+    return ($self->inline_get_slot_value($instance_var_name, $slot_name) . ' = ' . $value_name); 
+}
+
+sub inline_initialize_slot {
+    my ($self, $instance_var_name, $slot_name) = @_;
+    $self->inline_set_slot_value($instance_var_name, $slot_name, 'undef');
+}
+
+sub inline_is_slot_initialized {
+    my ($self, $instance_var_name, $slot_name) = @_;
+    return ('exists ' . $self->inline_get_slot_value($instance_var_name, $slot_name) . ' ? 1 : 0'); 
+}
 
 1;
 
@@ -49,9 +114,29 @@ Class::MOP::Instance - Instance Meta Object
 
 =item B<new>
 
-=item B<add_slot>
+=item B<bless_instance_structure>
+
+=item B<compute_layout_from_class>
+
+=item B<create_instance>
+
+=item B<get_all_slots>
+
+=item B<get_slot_value>
+
+=item B<set_slot_value>
+
+=item B<initialize_slot>
+
+=item B<is_slot_initialized>
+
+=item B<inline_get_slot_value>
+
+=item B<inline_set_slot_value>
+
+=item B<inline_initialize_slot>
 
-=item B<get_instance>
+=item B<inline_is_slot_initialized>
 
 =back
 
@@ -79,4 +164,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
-=cut
\ No newline at end of file
+=cut