X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=ecc61e103a466c19e91c9f5724bc731e4343f9d8;hp=a999394bb50ec0101ba748632bfceba6152810b2;hb=6423ed47a3392af0da9cd37ac8519583e51feb27;hpb=047d7af00ab8b37c6369c032211bfe492fe6cd05 diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index a999394..ecc61e1 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -203,6 +203,7 @@ sub add_method { package Mouse::Meta::Class; + sub is_anon_class{ return exists $_[0]->{anon_serial_id}; } @@ -217,6 +218,61 @@ sub get_all_attributes { return values %attrs; } +sub _initialize_object{ + my($self, $object, $args, $ignore_triggers) = @_; + + my @triggers_queue; + + foreach my $attribute ($self->get_all_attributes) { + my $init_arg = $attribute->init_arg; + my $slot = $attribute->name; + + if (defined($init_arg) && exists($args->{$init_arg})) { + $object->{$slot} = $attribute->_coerce_and_verify($args->{$init_arg}, $object); + + weaken($object->{$slot}) + if ref($object->{$slot}) && $attribute->is_weak_ref; + + if ($attribute->has_trigger) { + push @triggers_queue, [ $attribute->trigger, $object->{$slot} ]; + } + } + else { # no init arg + if ($attribute->has_default || $attribute->has_builder) { + if (!$attribute->is_lazy) { + my $default = $attribute->default; + my $builder = $attribute->builder; + my $value = $builder ? $object->$builder() + : ref($default) eq 'CODE' ? $object->$default() + : $default; + + $object->{$slot} = $attribute->_coerce_and_verify($value, $object); + + weaken($object->{$slot}) + if ref($object->{$slot}) && $attribute->is_weak_ref; + } + } + elsif($attribute->is_required) { + $self->throw_error("Attribute (".$attribute->name.") is required"); + } + } + } + + if(!$ignore_triggers){ + foreach my $trigger_and_value(@triggers_queue){ + my($trigger, $value) = @{$trigger_and_value}; + $trigger->($object, $value); + } + } + + if($self->is_anon_class){ + $object->{__METACLASS__} = $self; + } + + return; +} + + package Mouse::Meta::Role; @@ -337,8 +393,24 @@ sub compile_type_constraint{ return; } +package + Mouse::Object; +sub BUILDARGS { + my $class = shift; + + if (scalar @_ == 1) { + (ref($_[0]) eq 'HASH') + || $class->meta->throw_error("Single parameters to new() must be a HASH ref"); + + return {%{$_[0]}}; + } + else { + return {@_}; + } +} + 1; __END__