For Mouse this monkeypatching would work:
diff --git a/xs-src/MouseUtil.xs b/xs-src/MouseUtil.xs
index 3ec7d8c..e321f71 100644
--- a/xs-src/MouseUtil.xs
+++ b/xs-src/MouseUtil.xs
@@ -119,7 +119,6 @@ mouse_throw_error(SV* const metaobject, SV*
const data /* not used */, const cha
else {
call_pv("Mouse::Util::throw_error", G_VOID);
}
- croak("throw_error() did not throw the error (%"SVf")", message);
}
}
Followed by:
{
package Mouse::Error::WarnOnly;
use Carp;
sub Mouse::Util::throw_error :method {
my($self, $message, %args) = @_;
local $Carp::CarpLevel = $Carp::CarpLevel + 1 + ($args{depth} || 0);
local $Carp::MaxArgNums = 20; # default is 8, usually we use
named args which gets messier though
if(exists $args{longmess} && !$args{longmess}) {
Carp::croak($message);
}
else{
# This is the only change to the upstream subroutine,
which called confess
Carp::cluck($message);
}
}
}
package Foo;
use Mouse;
has x => (is => "ro", isa => "Int");
my $foo = Foo->new(x => "blah");
use Data::Dumper;
print Dumper $foo;
Which'll give you:
$ perl -Mblib -Ilib /tmp/error.pl
Subroutine throw_error redefined at
/home/avar/g/Mouse/blib/lib/Mouse/Util.pm line 350.
Attribute (x) does not pass the type constraint because:
Validation failed for 'Int' with value blah at /tmp/error.pl line 14
Mouse::Util::throw_error('Mouse::Meta::Attribute=HASH(0xd4bf68)',
'Attribute (x) does not pass the type constraint because: Vali...',
'data', 'blah', 'depth', -1) called at /tmp/error.pl line 22
$VAR1 = bless( {
'x' => 'blah'
}, 'Foo' );