From: Yuval Kogman Date: Thu, 26 Jun 2008 16:43:46 +0000 (+0000) Subject: BUILDARGS X-Git-Tag: 0.19~279 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d574882a10a05f5e8c515a87358460f7ae0ed247;p=gitmo%2FMouse.git BUILDARGS --- diff --git a/lib/Mouse/Object.pm b/lib/Mouse/Object.pm index 5b7d17e..f615ac9 100644 --- a/lib/Mouse/Object.pm +++ b/lib/Mouse/Object.pm @@ -9,17 +9,8 @@ use Carp 'confess'; sub new { my $class = shift; - my %args; - if (scalar @_ == 1) { - if (defined $_[0]) { - (ref($_[0]) eq 'HASH') - || confess "Single parameters to new() must be a HASH ref"; - %args = %{$_[0]}; - } - } - else { - %args = @_; - } + + my $args = $class->BUILDARGS(@_); my $instance = bless {}, $class; @@ -28,17 +19,17 @@ sub new { my $key = $attribute->name; my $default; - if (defined($from) && exists($args{$from})) { - $attribute->verify_type_constraint($args{$from}) + if (defined($from) && exists($args->{$from})) { + $attribute->verify_type_constraint($args->{$from}) if $attribute->has_type_constraint; - $instance->{$key} = $args{$from}; + $instance->{$key} = $args->{$from}; weaken($instance->{$key}) if ref($instance->{$key}) && $attribute->is_weak_ref; if ($attribute->has_trigger) { - $attribute->trigger->($instance, $args{$from}, $attribute); + $attribute->trigger->($instance, $args->{$from}, $attribute); } } else { @@ -69,11 +60,28 @@ sub new { } } - $instance->BUILDALL(\%args); + $instance->BUILDALL($args); return $instance; } +sub BUILDARGS { + my $class = shift; + + if (scalar @_ == 1) { + if (defined $_[0]) { + (ref($_[0]) eq 'HASH') + || confess "Single parameters to new() must be a HASH ref"; + return {%{$_[0]}}; + } else { + return {}; + } + } + else { + return {@_}; + } +} + sub DESTROY { shift->DEMOLISHALL } sub BUILDALL { diff --git a/t/032-buildargs.t b/t/032-buildargs.t new file mode 100644 index 0000000..209adc0 --- /dev/null +++ b/t/032-buildargs.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More tests => 3; + +use lib 't/lib'; + +{ + package Foo; + use Mouse; + + has foo => ( is => "rw" ); + + sub BUILDARGS { + my ( $self, @args ) = @_; + return { @args % 2 ? ( foo => @args ) : @args }; + } +} + +is( Foo->new->foo, undef, "no value" ); +is( Foo->new("bar")->foo, "bar", "single arg" ); +is( Foo->new(foo => "bar")->foo, "bar", "twoargs" ); +