view release on metacpan or  search on metacpan

lib/App/Stacktrace.pm  view on Meta::CPAN

      'm',        # Dump the generated script
      'v',        # Verbose
      'exec',     # exec() into gdb
      '--noexec', # system() into gdb
  );

=head2 run

Runs the app program as configured by the C<< ->new(...) >> method.

    $obj = App::Stacktrace->new( ... );
    $obj->run;

=cut

use strict;
use Config ();
use English -no_match_vars;
use Getopt::Long ();
use Pod::Usage ();
use XSLoader ();
use File::Temp ();

our $VERSION = '0.09';

XSLoader::load(__PACKAGE__, $VERSION);

sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;

    $self->_read_arguments( @_ );

    return $self;
}

sub run {
    my $self = shift;

    if ($self->{help}) {
        Pod::Usage::pod2usage(
            -verbose => 2,
            -exitcode => 0,
        );
    }

    my $script = $self->_custom_generated_script;
    if ($self->{dump_script}) {
        print $script;
    }
    else {
        $self->_run_gdb($script);
    }

    return;
}

sub _read_arguments {
    my $self = shift;
    local @ARGV = @_;
    my %args;
    Getopt::Long::GetOptions(
         \ %args,
        'help',
        'm',
        'v',
        'c',
        'exec!',
    )
      or Pod::Usage::pod2usage(
        -verbose => 2,
        -exitcode => 2 );
    if (1 == @ARGV && $ARGV[0] =~ /^\d+$/) {
        $args{pid} = shift @ARGV;
    }
    if (@ARGV) {
        Pod::Usage::pod2usage( -verbose => 2, -exitcode => 2 );
    }

    $self->{help}        = $args{help};
    $self->{pid}         = $args{pid};
    $self->{dump_script} = $args{m};
    $self->{verbose}     = $args{v};
    $self->{c_backtrace} = $args{v} || $args{c};
    $self->{exec}        = $args{exec};

    return;
}


sub _custom_generated_script {
    my ($self) = @_;

    # TODO: generate this statically
    for my $dir ( @INC ) {
        my $file = "$dir/App/Stacktrace/perl_backtrace_raw.txt";
        if (-e $file) {
            return $self->_TODO_add_constants( $file );
        }
    }

    die "Can't locate perl-backtrace.txt in \@INC (\@INC contains: @INC)";
}

sub _TODO_add_constants {
    my ($self, $template_script) = @_;

    my $this_library = __FILE__;
    my $src = <<"TODO_preamble";
# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
# This file is built by $this_library from its data.
# Any changes made here will be lost!
#
TODO_preamble

    if ($self->{verbose}) {
        $src .= <<VERBOSE;
set trace-commands on
set \$DEBUG = 1
VERBOSE