X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FClass.pm;h=4d07d55cec838747785f40b122a680f17f6e800f;hb=e000133868ec074e6b60baef47269c2d345adffc;hp=31261a32e9e1e3a717a3c1676e51b9c687d2d52f;hpb=2b72f3b429b2a05600a0b6dc227c78b949b886a2;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 31261a3..4d07d55 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -17,6 +17,7 @@ our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; use Moose::Meta::Method::Augmented; +use Moose::Error::Default; use base 'Class::MOP::Class'; @@ -27,21 +28,17 @@ __PACKAGE__->meta->add_attribute('roles' => ( __PACKAGE__->meta->add_attribute('constructor_class' => ( accessor => 'constructor_class', - default => sub { 'Moose::Meta::Method::Constructor' } + default => 'Moose::Meta::Method::Constructor', )); __PACKAGE__->meta->add_attribute('destructor_class' => ( accessor => 'destructor_class', - default => sub { 'Moose::Meta::Method::Destructor' } -)); - -__PACKAGE__->meta->add_attribute('error_builder' => ( - reader => 'error_builder', - default => 'confess', + default => 'Moose::Meta::Method::Destructor', )); __PACKAGE__->meta->add_attribute('error_class' => ( - reader => 'error_class', + accessor => 'error_class', + default => 'Moose::Error::Default', )); @@ -394,12 +391,11 @@ sub _reinitialize_with { bless $self, ref $new_self; - # FIXME? This seems to be necessary in some cases because of how - # Class::MOP::Class->construct_class_instance will weaken the - # metaclass store entry for an anonymous class. However, if that - # anonymous class is a metaclass's metaclass, we don't want it - # going out of scope. I'm not sure this is the right fix at all. + # We need to replace the cached metaclass instance or else when it + # goes out of scope Class::MOP::Class destroy's the namespace for + # the metaclass's class, causing much havoc. Class::MOP::store_metaclass_by_name( $self->name, $self ); + Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class; } # In the more complex case, we share a common ancestor with our @@ -657,13 +653,11 @@ sub make_immutable { ); } -#{ 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)); } @@ -675,65 +669,28 @@ sub raise_error { sub create_error { my ( $self, @args ) = @_; + require Carp::Heavy; + + local $error_level = ($error_level || 0 ) + 1; + if ( @args % 2 == 1 ) { unshift @args, "message"; } - my %args = ( meta => $self, error => $@, @args ); + my %args = ( metaclass => $self, last_error => $@, @args ); - local $level = $level + 1; + $args{depth} += $error_level; - 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 $class = ref $self ? $self->error_class : "Moose::Error::Default"; - my $builder_method = ( ( ref($builder) && ref($builder) eq 'CODE' ) - ? $builder - : ( $self->can("create_error_$builder") || "create_error_confess" )); - - return $self->$builder_method(%args); - } -} - -sub create_error_object { - my ( $self, %args ) = @_; - - my $class = delete $args{class}; + Class::MOP::load_class($class); $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::CarpLevel = $carp_level; # $Carp::CarpLevel + $carp_level ? - 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} ) { - return Carp::longmess(@args); - } else { - return Carp::shortmess(@args); - } -} - 1; __END__ @@ -853,6 +810,11 @@ immutable. These default to L and L respectively. These accessors are read-write, so you can use them to change the class name. +=item B + +Moose overrides this method from C and attempts to +fix some incompatibilities before doing the check. + =item B Throws the error created by C using C