view release on metacpan or  search on metacpan

FaultAutoBT.pm  view on Meta::CPAN

    # set/verify the 'exec_path' attribute
    if (exists $self->{exec_path}) {
        die "exec_path: $self->{exec_path} is not found"
            unless -e $self->{exec_path};
        die "exec_path: $self->{exec_path} is not executable"
            unless -x $self->{exec_path};
        $self->{exec_path_in} = $self->{exec_path};
    }
    else {
        $self->inteli_guess_exec_path();
        die "cannot figure out the executable path, ",
            "set the 'exec_path' attribute"
                unless exists $self->{exec_path_in};
    }


    # set/verify the 'command_path_in' attribute
    if (exists $self->{command_path}) {
        # the file should already exist and include the gdb commands
        die "command_path: cannot read $self->{command_path}"
            unless -r $self->{command_path};
        $self->{command_path_in} = $self->{command_path};
    }
    else {
        # use the default file and write it 
        $self->{command_path_in} = catfile $self->{dir}, COMMAND_FILE;
        $self->write_gdb_command_file();
    }

    # set/verify the 'command_path_base_in' attribute
    if (exists $self->{core_path_base}) {
        # try to create a file using this base
        my $try_path = $self->{core_path_base} . "00000";
        my $fh = Symbol::gensym();
        if (open $fh, ">$try_path") {
            close $fh;
            unlink $try_path;
        }
        else {
            die "core_path_base: $self->{core_path_base} doesn't seem to ",
                "be suitable as a base for the path that can be written to";
        }
        $self->{core_path_base_in} = $self->{core_path_base};
    }
    else {
        # use the default file and write it 
        $self->{core_path_base_in} = catfile $self->{dir}, CORE_FILE_BASE;
    }

    # set/verify the 'debugger' attribute
    # NOOP now

}

sub write_gdb_command_file {
    my $self = shift;

    #XXX: should we die here?
    #die "$self->{command_path_in} already exists, delete first" 
    #    if -e $self->{command_path_in};
    #warn "creating $self->{command_path_in} for user ".(getpwuid($>))[0]."\n";
    my $fh = Symbol::gensym();
    open $fh, ">$self->{command_path_in}"
        or die "can't open $self->{command_path_in} for writing: $!";
    print $fh <<EOI;
bt
kill
quit
EOI
    close $fh;
}

sub inteli_guess_exec_path {
    my $self = shift;

    if (-x $^X) {
        $self->{exec_path_in} = $^X;
    }
    elsif (-e '/proc/self/exe') {
        # linux?
        my $path = readlink("/proc/self/exe");
        $self->{exec_path_in} = $path if -e $path;
    }
    else {
        $self->{exec_path_in} = $Config{perlpath} if -x $Config{perlpath};
    }
}

sub ready {
    my $self = shift;
    #warn "calling @$self{qw(exec_path_in command_path_in core_path_base_in)}";
    set_segv_action($self->{exec_path_in},
                    $self->{command_path_in}, 
                    $self->{core_path_base_in});
}

DESTROY {
    my $self = shift;
    # XXX: test that this actually works, since we die here!
    # cleanup the autogenerated file if we have created it
    #unlink $self->{command_path_in} unless exists $self->{command_path};
}

1;
__END__


=head1 NAME

Debug::FaultAutoBT - Automatic Backtrace Extractor on SIGSEGV, SIGBUS, etc.

=head1 SYNOPSIS

  use Debug::FaultAutoBT;
  
  use File::Spec::Functions;
  my $tmp_dir = File::Spec::Functions::tmpdir;
  
  my $trace = Debug::FaultAutoBT->new(
      dir            => "$tmp_dir",
      #verbose        => 1,