--- /dev/null
+package Moose::Error::Confess;
+
+use base qw(Moose::Error::Default);
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Error::Confess - Prefer C<confess>
+
+=head1 SYNOPSIS
+
+ use metaclass => (
+ metaclass => "Moose::Meta::Class",
+ error_class => "Moose::Error::Confess",
+ );
+
+=head1 DESCRIPTION
+
+This error class uses L<Carp/confess> to raise errors generated in your
+metaclass.
+
+=cut
+
+
+
--- /dev/null
+package Moose::Error::Croak;
+
+use base qw(Moose::Error::Default);
+
+sub new {
+ my ( $self, @args ) = @_;
+ $self->create_error_croak(@args);
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Error::Croak - Prefer C<croak>
+
+=head1 SYNOPSIS
+
+ use metaclass => (
+ metaclass => "Moose::Meta::Class",
+ error_class => "Moose::Error::Croak",
+ );
+
+=head1 DESCRIPTION
+
+This error class uses L<Carp/croak> to raise errors generated in your
+metaclass.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Overrides L<Moose::Error::Default/new> to prefer C<croak>.
+
+=back
+
+=cut
+
+
--- /dev/null
+package Moose::Error::Default;
+
+sub new {
+ my ( $self, @args ) = @_;
+ $self->create_error_confess( @args );
+}
+
+sub create_error_croak {
+ my ( $self, @args ) = @_;
+ $self->_create_error_carpmess( @args );
+}
+
+sub create_error_confess {
+ my ( $self, @args ) = @_;
+ $self->_create_error_carpmess( @args, longmess => 1 );
+}
+
+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);
+ }
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Error::Default - L<Carp> based error generation for Moose.
+
+=head1 DESCRIPTION
+
+This class implements L<Carp> based error generation.
+
+The default behavior is like L<Moose::Error::Confess>.
+
+=head1 METHODS
+
+=over 4
+
+=item new @args
+
+Create a new error. Delegates to C<create_error_confess>.
+
+=item create_error_confess @args
+
+=item create_error_croak @args
+
+Creates a new errors string of the specified style.
+
+=back
+
+=cut
+
+
use Moose::Meta::Method::Overriden;
use Moose::Meta::Method::Augmented;
+use Moose::Error::Default;
use base 'Class::MOP::Class';
default => sub { 'Moose::Meta::Method::Destructor' }
));
-__PACKAGE__->meta->add_attribute('error_builder' => (
- reader => 'error_builder',
- default => 'confess',
-));
-
__PACKAGE__->meta->add_attribute('error_class' => (
- reader => 'error_class',
+ accessor => 'error_class',
+ default => 'Moose::Error::Default',
));
#{ package Moose::Meta::Class::ErrorRoutines; %Carp::Internal?
-our $level;
+our $error_level;
sub throw_error {
my ( $self, @args ) = @_;
- local $level = 1;
+ local $error_level = ($error_level || 0) + 1;
$self->raise_error($self->create_error(@args));
}
require Carp::Heavy;
- local $level = $level + 1;
-
+ local $error_level = ($error_level || 0 ) + 1;
if ( @args % 2 == 1 ) {
unshift @args, "message";
}
- my %args = ( Carp::caller_info($level), metaclass => $self, error => $@, @args );
-
- if ( my $class = $args{class} || ( ref $self && $self->error_class ) ) {
- return $self->create_error_object( %args, class => $class );
- } else {
- my $builder = $args{builder} || ( ref($self) ? $self->error_builder : "confess" );
-
- my $builder_method = ( ( ref($builder) && ref($builder) eq 'CODE' )
- ? $builder
- : ( $self->can("create_error_$builder") || "create_error_confess" ));
+ my %args = ( metaclass => $self, error => $@, @args );
- return $self->$builder_method(%args);
- }
-}
-
-sub create_error_object {
- my ( $self, %args ) = @_;
+ $args{depth} += $error_level;
- my $class = delete $args{class};
+ my $class = ref $self ? $self->error_class : "Moose::Error::Default";
$class->new(
- %args,
- depth => ( ($args{depth} || 1) + ( $level + 1 ) ),
+ Carp::caller_info($args{depth}),
+ %args
);
}
-sub create_error_croak {
- my ( $self, @args ) = @_;
- $self->_create_error_carpmess( @args );
-}
-
-sub create_error_confess {
- my ( $self, @args ) = @_;
- $self->_create_error_carpmess( @args, longmess => 1 );
-}
-
-sub _create_error_carpmess {
- my ( $self, %args ) = @_;
-
- my $carp_level = $level + 1 + ( $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;
__END__
package Bar;
use metaclass (
metaclass => "Moose::Meta::Class",
- error_builder => "croak",
- );
- use Moose;
-
- has foo => ( is => "ro" );
-
- package Baz;
- use metaclass (
- metaclass => "Moose::Meta::Class",
- error_class => "Baz::Error",
+ error_class => "Moose::Error::Croak",
);
use Moose;
has foo => ( is => "ro" );
+
package Baz::Error;
use Moose;
has data => ( is => "ro" );
has line => ( isa => "Int", is => "ro" );
has file => ( isa => "Str", is => "ro" );
+
+ package Baz;
+ use metaclass (
+ metaclass => "Moose::Meta::Class",
+ error_class => "Baz::Error",
+ );
+ use Moose;
+
+ has foo => ( is => "ro" );
}
my $line;