From: Shawn M Moore Date: Thu, 14 Jun 2012 16:09:42 +0000 (-0500) Subject: Import Throwable X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f92fabb06aa9a892339563d06ca05d862691643;p=gitmo%2FMoose.git Import Throwable --- diff --git a/lib/StackTrace/Auto.pm b/lib/StackTrace/Auto.pm new file mode 100644 index 0000000..2749604 --- /dev/null +++ b/lib/StackTrace/Auto.pm @@ -0,0 +1,117 @@ +package StackTrace::Auto; +use Moose::Role 0.87; +# ABSTRACT: a role for generating stack traces during instantiation + +=head1 SYNOPSIS + +First, include StackTrace::Auto in a Moose class... + + package Some::Class; + use Moose; + with 'StackTrace::Auto'; + +...then create an object of that class... + + my $obj = Some::Class->new; + +...and now you have a stack trace for the object's creation. + + print $obj->stack_trace->as_string; + +=attr stack_trace + +This attribute will contain an object representing the stack at the point when +the error was generated and thrown. It must be an object performing the +C method. + +=attr stack_trace_class + +This attribute may be provided to use an alternate class for stack traces. The +default is L. + +In general, you will not need to think about this attribute. + +=cut + +{ + use Moose::Util::TypeConstraints; + + has stack_trace => ( + is => 'ro', + isa => duck_type([ qw(as_string) ]), + builder => '_build_stack_trace', + init_arg => undef, + ); + + my $tc = subtype as 'ClassName'; + coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ }; + + has stack_trace_class => ( + is => 'ro', + isa => $tc, + coerce => 1, + lazy => 1, + builder => '_build_stack_trace_class', + ); + + no Moose::Util::TypeConstraints; +} + +=attr stack_trace_args + +This attribute is an arrayref of arguments to pass when building the stack +trace. In general, you will not need to think about it. + +=cut + +has stack_trace_args => ( + is => 'ro', + isa => 'ArrayRef', + lazy => 1, + builder => '_build_stack_trace_args', +); + +sub _build_stack_trace_class { + return 'Devel::StackTrace'; +} + +sub _build_stack_trace_args { + my ($self) = @_; + my $found_mark = 0; + my $uplevel = 3; # number of *raw* frames to go up after we found the marker + return [ + frame_filter => sub { + my ($raw) = @_; + if ($found_mark) { + return 1 unless $uplevel; + return !$uplevel--; + } + else { + $found_mark = scalar $raw->{caller}->[3] =~ /__stack_marker$/; + return 0; + } + }, + ]; +} + +sub _build_stack_trace { + my ($self) = @_; + return $self->stack_trace_class->new( + @{ $self->stack_trace_args }, + ); +} + +around new => sub { + my $next = shift; + my $self = shift; + return $self->__stack_marker($next, @_); +}; + +sub __stack_marker { + my $self = shift; + my $next = shift; + return $self->$next(@_); +} + +no Moose::Role; +1; diff --git a/lib/Throwable.pm b/lib/Throwable.pm new file mode 100644 index 0000000..18d7352 --- /dev/null +++ b/lib/Throwable.pm @@ -0,0 +1,63 @@ +package Throwable; +use Moose::Role 0.87; +# ABSTRACT: a role for classes that can be thrown + +=head1 SYNOPSIS + + package Redirect; + use Moose; + with 'Throwable'; + + has url => (is => 'ro'); + +...then later... + + Redirect->throw({ url => $url }); + +=head1 DESCRIPTION + +Throwable is a role for classes that are meant to be thrown as exceptions to +standard program flow. It is very simple and does only two things: saves any +previous value for C<$@> and calls C. + +=attr previous_exception + +This attribute is created automatically, and stores the value of C<$@> when the +Throwable object is created. + +=cut + +has 'previous_exception' => ( + is => 'ro', + init_arg => undef, + default => sub { + return unless defined $@ and (ref $@ or length $@); + return $@; + }, +); + +=method throw + + Something::Throwable->throw({ attr => $value }); + +This method will call new, passing all arguments along to new, and will then +use the created object as the only argument to C. + +If called on an object that does Throwable, the object will be rethrown. + +=cut + +sub throw { + my ($inv) = shift; + + if (blessed $inv) { + confess "throw called on Throwable object with arguments" if @_; + die $inv; + } + + my $throwable = $inv->new(@_); + die $throwable; +} + +no Moose::Role; +1; diff --git a/lib/Throwable/Error.pm b/lib/Throwable/Error.pm new file mode 100644 index 0000000..4e6f666 --- /dev/null +++ b/lib/Throwable/Error.pm @@ -0,0 +1,99 @@ +package Throwable::Error; +use Moose 0.87; +with 'Throwable', 'StackTrace::Auto'; +# ABSTRACT: an easy-to-use class for error objects + +=head1 SYNOPSIS + + package MyApp::Error; + use Moose; + extends 'Throwable::Error'; + + has execution_phase => ( + is => 'ro', + isa => 'MyApp::Phase', + default => 'startup', + ); + +...and in your app... + + MyApp::Error->throw("all communications offline"); + + # or... + + MyApp::Error->throw({ + message => "all communications offline", + phase => 'shutdown', + }); + +=head1 DESCRIPTION + +Throwable::Error is a base class for exceptions that will be thrown to signal +errors and abort normal program flow. Throwable::Error is an alternative to +L, the features of which are largely +provided by the Moose object system atop which Throwable::Error is built. + +Throwable::Error performs the L and L +roles. That means you can call C on it to create and throw n error +object in one call, and that every error object will have a stack trace for its +creation. + +=cut + +use overload + q{""} => 'as_string', + fallback => 1; + +=attr message + +This attribute must be defined and must contain a string describing the error +condition. This string will be printed at the top of the stack trace when the +error is stringified. + +=cut + +has message => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +=attr stack_trace + +This attribute, provided by L, will contain a stack trace +object guaranteed to respond to the C method. For more information +about the stack trace and associated behavior, consult the L +docs. + +=method as_string + +This method will provide a string representing the error, containing the +error's message followed by the its stack trace. + +=cut + +sub as_string { + my ($self) = @_; + + my $str = $self->message; + $str .= "\n\n" . $self->stack_trace->as_string; + + return $str; +} + +sub BUILDARGS { + my ($self, @args) = @_; + + return {} unless @args; + return {} if @args == 1 and ! defined $args[0]; + + if (@args == 1 and (!ref $args[0]) and defined $args[0] and length $args[0]) { + return { message => $args[0] }; + } + + return $self->SUPER::BUILDARGS(@args); +} + +__PACKAGE__->meta->make_immutable(inline_constructor => 0); +no Moose; +1;