lib/StackTrace/Auto.pm

   1 package StackTrace::Auto;
   2 use Moose::Role 0.87;
   3 # ABSTRACT: a role for generating stack traces during instantiation
   4
   5 =head1 SYNOPSIS
   6
   7 First, include StackTrace::Auto in a Moose class...
   8
   9   package Some::Class;
  10   use Moose;
  11   with 'StackTrace::Auto';
  12
  13 ...then create an object of that class...
  14
  15   my $obj = Some::Class->new;
  16
  17 ...and now you have a stack trace for the object's creation.
  18
  19   print $obj->stack_trace->as_string;
  20
  21 =attr stack_trace
  22
  23 This attribute will contain an object representing the stack at the point when
  24 the error was generated and thrown.  It must be an object performing the
  25 C<as_string> method.
  26
  27 =attr stack_trace_class
  28
  29 This attribute may be provided to use an alternate class for stack traces.  The
  30 default is L<Devel::StackTrace|Devel::StackTrace>.
  31
  32 In general, you will not need to think about this attribute.
  33
  34 =cut
  35
  36 {
  37   use Moose::Util::TypeConstraints;
  38
  39   has stack_trace => (
  40     is       => 'ro',
  41     isa      => duck_type([ qw(as_string) ]),
  42     builder  => '_build_stack_trace',
  43     init_arg => undef,
  44   );
  45
  46   my $tc = subtype as 'ClassName';
  47   coerce $tc, from 'Str', via { Class::MOP::load_class($_); $_ };
  48
  49   has stack_trace_class => (
  50     is      => 'ro',
  51     isa     => $tc,
  52     coerce  => 1,
  53     lazy    => 1,
  54     builder => '_build_stack_trace_class',
  55   );
  56
  57   no Moose::Util::TypeConstraints;
  58 }
  59
  60 =attr stack_trace_args
  61
  62 This attribute is an arrayref of arguments to pass when building the stack
  63 trace.  In general, you will not need to think about it.
  64
  65 =cut
  66
  67 has stack_trace_args => (
  68   is      => 'ro',
  69   isa     => 'ArrayRef',
  70   lazy    => 1,
  71   builder => '_build_stack_trace_args',
  72 );
  73
  74 sub _build_stack_trace_class {
  75   return 'Devel::StackTrace';
  76 }
  77
  78 sub _build_stack_trace_args {
  79   my ($self) = @_;
  80   my $found_mark = 0;
  81   my $uplevel = 3; # number of *raw* frames to go up after we found the marker
  82   return [
  83     frame_filter => sub {
  84       my ($raw) = @_;
  85       if ($found_mark) {
  86           return 1 unless $uplevel;
  87           return !$uplevel--;
  88       }
  89       else {
  90         $found_mark = scalar $raw->{caller}->[3] =~ /__stack_marker$/;
  91         return 0;
  92     }
  93     },
  94   ];
  95 }
  96
  97 sub _build_stack_trace {
  98   my ($self) = @_;
  99   return $self->stack_trace_class->new(
 100     @{ $self->stack_trace_args },
 101   );
 102 }
 103
 104 around new => sub {
 105   my $next = shift;
 106   my $self = shift;
 107   return $self->__stack_marker($next, @_);
 108 };
 109
 110 sub __stack_marker {
 111   my $self = shift;
 112   my $next = shift;
 113   return $self->$next(@_);
 114 }
 115
 116 no Moose::Role;
 117 1;