From: Yuval Kogman Date: Fri, 8 Aug 2008 23:25:14 +0000 (+0000) Subject: more fixes for Instance's constructor X-Git-Tag: 0_64_01~69 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=63d08a9ec7cf3a1e74e999aabd54344a518a109d;p=gitmo%2FClass-MOP.git more fixes for Instance's constructor --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index a0731b3..ed5195f 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -722,14 +722,36 @@ Class::MOP::Method::Constructor->meta->add_method('new' => sub { # these don't yet do much of anything, but are just # included for completeness +#Class::MOP::Instance->meta->add_method('new' => sub { +# my $class = shift; +# my $options = $class->BUILDARGS($class); +# +# # return the new object +# my $self = $class->meta->new_object(%$options); +# +# # we don't want this creating +# # a cycle in the code, if not +# # needed +# Scalar::Util::weaken($self->{'associated_metaclass'}); +# +# $self->initialize_body; +# +# $self; +#}); + Class::MOP::Instance->meta->add_attribute( - Class::MOP::Attribute->new('meta') + Class::MOP::Attribute->new('associated_metaclass') ); Class::MOP::Instance->meta->add_attribute( Class::MOP::Attribute->new('slots') ); +Class::MOP::Instance->meta->add_attribute( + Class::MOP::Attribute->new('slot_hash') +); + + ## -------------------------------------------------------- ## Now close all the Class::MOP::* classes diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 7349abc..2d3079a 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -11,21 +11,28 @@ our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; -sub new { +sub BUILDARGS { my ($class, @args) = @_; if ( @args == 1 ) { - unshift @args, "metaclass"; + unshift @args, "associated_metaclass"; } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) { # compat mode my ( $meta, @attrs ) = @args; - @args = ( metaclass => $meta, attributes => \@attrs ); + @args = ( associated_metaclass => $meta, attributes => \@attrs ); } my %options = @args; - # FIXME lazy_build $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ]; + $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build + + return \%options; +} + +sub new { + my $class = shift; + my $options = $class->BUILDARGS(@_); # FIXME replace with a proper constructor my $instance = bless { @@ -39,18 +46,18 @@ sub new { # which is *probably* a safe # assumption,.. but you can # never tell <:) - 'meta' => $options{metaclass}, # FIXME rename to associated metaclass with a compat alias? - 'slots' => $options{slots}, - 'slot_hash' => { map { $_ => undef } @{ $options{slots} } }, # FIXME lazy_build + 'associated_metaclass' => $options->{associated_metaclass}, + 'slots' => $options->{slots}, + 'slot_hash' => $options->{slot_hash}, } => $class; # FIXME weak_ref => 1, - weaken($instance->{'meta'}); + weaken($instance->{'associated_metaclass'}); return $instance; } -sub associated_metaclass { (shift)->{'meta'} } +sub associated_metaclass { (shift)->{'associated_metaclass'} } sub create_instance { my $self = shift; @@ -215,15 +222,18 @@ F for details). =over 4 -=item B +=item B Creates a new instance meta-object and gathers all the slots from the list of C<@attrs> given. +=item B + +Processes arguments for compatibility. + =item B -This will return a B instance which is related -to this class. +Returns the metaclass of L. =back