From: Shawn M Moore Date: Tue, 6 Oct 2009 21:15:40 +0000 (-0400) Subject: Skip class_type etc stack frames when checking the package that defines a subtype X-Git-Tag: 0.38~15 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0608c8c81819673540f51f8ab44b6f3364cae53f;p=gitmo%2FMouse.git Skip class_type etc stack frames when checking the package that defines a subtype --- diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 54246b8..0edd9b6 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -151,7 +151,7 @@ sub subtype { $name = '__ANON__' if !defined $name; - my $pkg = caller; + my $pkg = caller($conf{_caller_level} || 1); if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) { Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg"; @@ -218,11 +218,15 @@ sub class_type { if ($conf && $conf->{class}) { # No, you're using this wrong warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?"; - subtype $name => (as => $conf->{class}); + subtype $name => ( + as => $conf->{class}, + caller_level => (($conf->{_caller_level}||0) + 1), + ); } else { subtype $name => ( where => sub { blessed($_) && $_->isa($name) }, + caller_level => (($conf->{_caller_level}||0) + 1), ); } } @@ -232,6 +236,7 @@ sub role_type { my $role = $conf->{role}; subtype $name => ( where => sub { does_role($_, $role) }, + caller_level => (($conf->{_caller_level}||0) + 1), ); } @@ -270,8 +275,9 @@ sub enum { my $name = shift; my %is_valid = map { $_ => 1 } @_; - subtype( - $name => where => sub { $is_valid{$_} } + subtype $name => ( + where => sub { $is_valid{$_} }, + _caller_level => 1, ); }