make auto-stack-tracing a role

lib/Role/AutoTrace.pm

@@ -0,0 +1,100 @@
+package Role::AutoTrace;
+use Moose::Role 0.87;
+# ABSTRACT: a role for generating stack traces during instantiation
+
+=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<as_string> method.
+
+=attr stack_trace_class
+
+This attribute may be provided to use an alternate class for stack traces.  The
+default is L<Devel::StackTrace|Devel::StackTrace>.
+
+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',
+  );
+
+  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;

lib/Throwable/Error.pm

@@ -1,6 +1,6 @@
 package Throwable::Error;
 use Moose 0.87;
-with 'Throwable';
+with 'Throwable', 'Role::AutoTrace';
 # ABSTRACT: an easy-to-use class for error objects
 
 =head1 SYNOPSIS
@@ -71,88 +71,6 @@ sub as_string {
   return $str;
 }
 
-=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<as_string> method.
-
-=attr stack_trace_class
-
-This attribute may be provided to use an alternate class for stack traces.  The
-default is L<Devel::StackTrace|Devel::StackTrace>.
-
-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',
-  );
-
-  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 },
-  );
-}
-
 sub BUILDARGS {
   my ($self, @args) = @_;
 
@@ -166,17 +84,5 @@ sub BUILDARGS {
   return $self->SUPER::BUILDARGS(@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;
 1;