X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FError%2FDefault.pm;h=b3c2f876ecafb1ed4b779faf479926df639f0145;hb=48ac876af2c1991bd6cdba0d54b775a121e01725;hp=9a19b1af36762d1ad3646aaf0702d0d96da23273;hpb=40290d18183d44ddbb0f4fdd2f75ffb7955bbfcf;p=gitmo%2FMoose.git diff --git a/lib/Moose/Error/Default.pm b/lib/Moose/Error/Default.pm index 9a19b1a..b3c2f87 100644 --- a/lib/Moose/Error/Default.pm +++ b/lib/Moose/Error/Default.pm @@ -3,71 +3,78 @@ package Moose::Error::Default; use strict; use warnings; -our $VERSION = '1.04'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - use Carp::Heavy; +use Class::MOP::MiniTrait; + +use Moose::Error::Util; + +use base 'Class::MOP::Object'; +Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait'); sub new { my ( $self, @args ) = @_; - $self->create_error_confess( @args ); + # can't use Moose::Error::Util::create_error here because that would break + # inheritance. we don't care about that for the inlined version, because + # the inlined versions are explicitly not inherited. + if (defined $ENV{MOOSE_ERROR_STYLE} && $ENV{MOOSE_ERROR_STYLE} eq 'croak') { + $self->create_error_croak( @args ); + } + else { + $self->create_error_confess( @args ); + } +} + +sub _inline_new { + my ( $self, %args ) = @_; + + my $depth = ($args{depth} || 0) - 1; + return 'Moose::Error::Util::create_error(' + . 'message => ' . $args{message} . ', ' + . 'depth => ' . $depth . ', ' + . ')'; } sub create_error_croak { my ( $self, @args ) = @_; - $self->_create_error_carpmess( @args ); + return Moose::Error::Util::create_error_croak(@args); } sub create_error_confess { my ( $self, @args ) = @_; - $self->_create_error_carpmess( @args, longmess => 1 ); + return Moose::Error::Util::create_error_confess(@args); } -sub _create_error_carpmess { - my ( $self, %args ) = @_; - - my $carp_level = 3 + ( $args{depth} || 1 ); - local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though - - my @args = exists $args{message} ? $args{message} : (); - - if ( $args{longmess} || $Carp::Verbose ) { - local $Carp::CarpLevel = ( $Carp::CarpLevel || 0 ) + $carp_level; - return Carp::longmess(@args); - } else { - return Carp::ret_summary($carp_level, @args); - } -} +1; -__PACKAGE__ +# ABSTRACT: L based error generation for Moose. __END__ =pod -=head1 NAME - -Moose::Error::Default - L based error generation for Moose. - =head1 DESCRIPTION This class implements L based error generation. -The default behavior is like L. +The default behavior is like L. To override this to +default to L's behaviour on a system wide basis, set the +MOOSE_ERROR_STYLE environment variable to C. The use of this +environment variable is considered experimental, and may change in a future +release. =head1 METHODS =over 4 -=item new @args +=item B<< Moose::Error::Default->new(@args) >> -Create a new error. Delegates to C. +Create a new error. Delegates to C or +C. -=item create_error_confess @args +=item B<< $error->create_error_confess(@args) >> -=item create_error_croak @args +=item B<< $error->create_error_croak(@args) >> Creates a new errors string of the specified style.