File Coverage

blib/lib/Devel/StackTrace/Extract.pm

Criterion	Covered	Total	%
statement	18	40	45.0
branch	0	14	0.0
condition			n/a
subroutine	6	8	75.0
pod	1	1	100.0
total	25	63	39.6

package Devel::StackTrace::Extract;
use base qw(Exporter);

use strict;
use warnings;

our $VERSION = '1.000000';

use Devel::StackTrace;
use Devel::StackTrace::Frame;
use Scalar::Util qw(blessed);

our @EXPORT_OK;

sub extract_stack_trace {
    my $ex = shift;

    # non objects do not contain stack frames
    return undef unless blessed($ex);

    # anything that does StackTrace::Auto (including anything that does
    # Throwable::Error) will implement this
    return $ex->stack_trace if $ex->can('stack_trace');

    if ( $ex->isa('Mojo::Exception') ) {

        # make sure this is a modern version of Mojo using
        return undef unless $ex->can('frames');

        # it's possible for Mojo exceptions not to have stack frames
        my $frames = $ex->frames;
        return undef unless @{ $frames || [] };

        return _build_devel_trace_from_mojo_exception($ex);
    }

    # Exception::Class and Moose::Exception and friends use 'trace'.  Note the
    # importance of putting this *after* the Mojo::Exception check, as that
    # module implements a 'trace' method that *sets* the current stack trace,
    # not returns the current stack trace
    return $ex->trace if $ex->can('trace');

    # dunno how to get the stack trace, give up and return undef
    return undef;
}
push @EXPORT_OK, 'extract_stack_trace';

sub _build_devel_trace_from_mojo_exception {
    my $ex = shift;

    my $message = $ex->message;
    my $frames  = $ex->frames;

    my $trace = Devel::StackTrace->new(
        message     => $message,
        skip_frames => ~0 - 1,    # skip all frames, we're doing this by hand!
    );

    # convert the Mojo::Exception frames into Devel::StackTrace::Frame frames
    my @new_frames;
    foreach my $old_frame ( @{$frames} ) {

        # right now this is a somewhat undocumented interface to
        # Devel::StackFrame::Frame, but Dave Rolsky is at least aware
        # that this code does this.
        push @new_frames, Devel::StackTrace::Frame->new(
            $old_frame,
            [],    # we don't know the parameters that were passed, ooops

            # these are all the default from Devel::StackTrace
            undef,       # respect_overload,
            undef,       # max_arg_length
            $message,    # message
            undef,       # indent
        );
    }

    # work around of bug in Devel::StackTrace 2.00 where it still tries to
    # convert the raw frames into frames if you manually set them unless you've
    # read the frames once
    $trace->frames;

    $trace->frames(@new_frames);
    return $trace;
}

1;

# ABSTRACT: Extract a stack trace from an exception object

__END__