From: Stevan Little Date: Wed, 26 Apr 2006 22:52:21 +0000 (+0000) Subject: testing X-Git-Tag: 0_29_02~48 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=24869f62f2c588b527cdb80aee59a9867e51f0ba;p=gitmo%2FClass-MOP.git testing --- diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index df0fb3c..f8cfe64 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -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: diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index ad5fff7..4ea50b1 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -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 index 0000000..7d1e573 --- /dev/null +++ b/lib/Class/MOP/Instance.pm @@ -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 + +=item B + +=item B + +=back + +=head2 Introspection + +=over 4 + +=item B + +This will return a B instance which is related +to this class. + +=back + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +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