view release on metacpan or  search on metacpan

lib/Parse/StackTrace.pm  view on Meta::CPAN

package Parse::StackTrace;
use 5.006;
use Moose;
use Parse::StackTrace::Exceptions;
use Exception::Class;
use List::Util qw(max min);
use Scalar::Util qw(blessed);

our $VERSION = '0.08';

has 'threads'    => (is => 'ro', isa => 'ArrayRef[Parse::StackTrace::Thread]',
                     required => 1);
has 'binary'     => (is => 'ro', isa => 'Str|Undef');
has 'text_lines' => (is => 'ro', isa => 'ArrayRef[Str]', required => 1);

# Defaults for StackTrace types that don't define these.
use constant BIN_REGEX => '';
use constant IGNORE_LINES => {};

our $WHITESPACE_ONLY = qr/^\s*$/;

#####################
# Parsing Functions #
#####################

sub parse {
    my $class = shift;
    # If you call parse() directly on this class, then we use the "type"
    # parameter to determine what type of StackTrace we're parsing.
    if ($class eq 'Parse::StackTrace') {
        my %params = @_;
        my $types = $params{'types'};
        die "You must specify trace types" if !$types || !scalar @$types;
        my $trace;
        foreach my $type (@$types) {
            my $parser = $class->_class("Type::$type");
            $trace = $parser->parse(@_);
            return $trace if $trace;
        }
        
        return undef;
    }
    
    # For subclasses
    return $class->_do_parse(@_);
}

sub _do_parse {
    my ($class, %params) = @_;
    my $text  = $params{text};
    my $debug = $params{debug};
    
    die "You must specify a value for the 'text' argument" if !defined $text;
    if ($text !~ $class->HAS_TRACE) {
        return undef;
    }
    
    my $binary;
    if ($class->BIN_REGEX and $text =~ $class->BIN_REGEX) {
        $binary = $1;
    }

    my ($threads, $trace_lines) = $class->_parse_text($text, $debug);
    my $trace = $class->new(threads => $threads, binary => $binary,
                            text_lines => $trace_lines);
    return $trace;
}

sub _parse_text {
    my ($class, $text, $debug) = @_;
   
    my @lines = split(/\r?\n/, $text);
    my @threads;
    my $default_thread = $class->thread_class->new();