testing
Stevan Little [Wed, 26 Apr 2006 22:52:21 +0000 (22:52 +0000)]
lib/Class/MOP/Attribute.pm
lib/Class/MOP/Class.pm
lib/Class/MOP/Instance.pm [new file with mode: 0644]

index df0fb3c..f8cfe64 100644 (file)
@@ -61,7 +61,7 @@ sub clone {
 }
 
 sub initialize_instance_slot {
-    my ($self, $class, $instance, $params) = @_;
+    my ($self, $class, $meta_instance, $params) = @_;
     my $init_arg = $self->{init_arg};
     # try to fetch the init arg from the %params ...
     my $val;        
@@ -69,9 +69,9 @@ sub initialize_instance_slot {
     # if nothing was in the %params, we can use the 
     # attribute's default value (if it has one)
     if (!defined $val && defined $self->{default}) {
-        $val = $self->default($instance); 
+        $val = $self->default($meta_instance->get_instance); 
     }            
-    $instance->{$self->name} = $val;    
+    $meta_instance->add_slot($self->name, $val);    
 }
 
 # NOTE:
index ad5fff7..4ea50b1 100644 (file)
@@ -170,16 +170,17 @@ sub new_object {
     # which will deal with the singletons
     return $class->construct_class_instance(@_)
         if $class->name->isa('Class::MOP::Class');
-    bless $class->construct_instance(@_) => $class->name;
+    return $class->construct_instance(@_);
 }
 
 sub construct_instance {
     my ($class, %params) = @_;
-    my $instance = {};
+    require Class::MOP::Instance;
+    my $meta_instance = Class::MOP::Instance->new($class);
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        $attr->initialize_instance_slot($class, $instance, \%params);
+        $attr->initialize_instance_slot($class, $meta_instance, \%params);
     }
-    return $instance;
+    return $meta_instance->get_instance;
 }
 
 sub clone_object {
diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
new file mode 100644 (file)
index 0000000..7d1e573
--- /dev/null
@@ -0,0 +1,82 @@
+
+package Class::MOP::Instance;
+
+use strict;
+use warnings;
+
+use Carp         'confess';
+use Scalar::Util 'blessed', 'reftype', 'weaken';
+
+our $VERSION = '0.01';
+
+sub meta { 
+    require Class::MOP::Class;
+    Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
+}
+
+sub new { 
+    my $class = shift;
+    my $meta  = shift;
+    bless {
+        instance => bless {} => $meta->name
+    } => $class; 
+}
+
+sub add_slot {
+    my ($self, $slot_name, $value) = @_;
+    return $self->{instance}->{$slot_name} = $value;
+}
+
+sub get_instance { (shift)->{instance} }
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME 
+
+Class::MOP::Instance - Instance Meta Object
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item B<new>
+
+=item B<add_slot>
+
+=item B<get_instance>
+
+=back
+
+=head2 Introspection
+
+=over 4
+
+=item B<meta>
+
+This will return a B<Class::MOP::Class> instance which is related 
+to this class.
+
+=back
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+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