X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FInstance.pm;h=07c60c009409a78570e838250b00e0e2caf416e5;hb=0e734d64ed657f0acb36d0ec28b6d03019405d14;hp=d71ef7fc6f655308626773c410860e7dd161912f;hpb=af72687d6d45c59be325b4d43c852606c8a2c9c1;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index d71ef7f..07c60c0 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -6,7 +6,7 @@ use warnings; use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.85'; +our $VERSION = '1.03'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -45,8 +45,12 @@ sub new { } sub _new { - my ( $class, %options ) = @_; - bless { + my $class = shift; + return Class::MOP::Class->initialize($class)->new_object(@_) + if $class ne __PACKAGE__; + + my $params = @_ == 1 ? $_[0] : {@_}; + return bless { # NOTE: # I am not sure that it makes # sense to pass in the meta @@ -57,10 +61,10 @@ sub _new { # which is *probably* a safe # assumption,.. but you can # never tell <:) - 'associated_metaclass' => $options{associated_metaclass}, - 'attributes' => $options{attributes}, - 'slots' => $options{slots}, - 'slot_hash' => $options{slot_hash}, + 'associated_metaclass' => $params->{associated_metaclass}, + 'attributes' => $params->{attributes}, + 'slots' => $params->{slots}, + 'slot_hash' => $params->{slot_hash}, } => $class; } @@ -73,15 +77,6 @@ sub create_instance { bless {}, $self->_class_name; } -# for compatibility -sub bless_instance_structure { - Carp::cluck('The bless_instance_structure method is deprecated.' - . " It will be removed in a future release.\n"); - - my ($self, $instance_structure) = @_; - bless $instance_structure, $self->_class_name; -} - sub clone_instance { my ($self, $instance) = @_; bless { %$instance }, $self->_class_name; @@ -214,6 +209,11 @@ sub inline_strengthen_slot_value { $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name)); } +sub inline_rebless_instance_structure { + my ($self, $instance, $class_variable) = @_; + "bless $instance => $class_variable"; +} + 1; __END__ @@ -385,6 +385,12 @@ The second argument is a slot name. The method returns a snippet of code that, when inlined, performs some operation on the instance. +=item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >> + +This takes the name of a variable that will, when inlined, represent the object +instance, and the name of a variable that will represent the class to rebless +into, and returns code to rebless an instance into a class. + =back =head2 Introspection @@ -409,7 +415,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L