Current File : //usr/share/perl5/vendor_perl/StackTrace/Auto.pm
package StackTrace::Auto;
BEGIN {
$StackTrace::Auto::VERSION = '0.102080';
}
use Moose::Role 0.87;
# ABSTRACT: a role for generating stack traces during instantiation
{
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;
}
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;
__END__
=pod
=head1 NAME
StackTrace::Auto - a role for generating stack traces during instantiation
=head1 VERSION
version 0.102080
=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;
=head1 ATTRIBUTES
=head2 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.
=head2 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.
=head2 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.
=head1 AUTHORS
=over 4
=item *
Ricardo SIGNES <rjbs@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by Ricardo SIGNES.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
Mini Shell