X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FConstructor.pm;h=d68e95858e7dd1753fb127d9744c7c4fa0f1c609;hp=f95775031ace15ab4f7529855607e5c3e2753551;hb=420c0e9300dd016b83e1afb25576a877afdbd59d;hpb=8215d7254eb706c929b0cfa9efafb7a5e6db658b diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index f957750..d68e958 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -1,9 +1,8 @@ package Mouse::Meta::Method::Constructor; -use strict; -use warnings; +use Mouse::Util; # enables strict and warnings -sub generate_constructor_method_inline { - my ($class, $metaclass) = @_; +sub _generate_constructor_method { + my ($class, $metaclass, $args) = @_; my $associated_metaclass_name = $metaclass->name; my @attrs = $metaclass->get_all_attributes; @@ -15,23 +14,31 @@ sub generate_constructor_method_inline { my @compiled_constraints = map { $_ ? $_->_compiled_type_constraint : undef } map { $_->type_constraint } @attrs; - my $code = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; - sub { - my \$class = shift; - return \$class->Mouse::Object::new(\@_) - if \$class ne q{$associated_metaclass_name}; - $buildargs; - my \$instance = bless {}, \$class; - $processattrs; - $buildall; - return \$instance; - } + + + my $source = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; + sub \{ + my \$class = shift; + return \$class->Mouse::Object::new(\@_) + if \$class ne q{$associated_metaclass_name}; + $buildargs; + my \$instance = bless {}, \$class; + $processattrs; + $buildall; + return \$instance; + } ... - local $@; - my $res = eval $code; - die $@ if $@; - $res; + my $code; + my $e = do{ + local $@; + $code = eval $source; + $@; + }; + die $e if $e; + + $metaclass->add_method($args->{constructor_name} => $code); + return; } sub _generate_processattrs {