-
Notifications
You must be signed in to change notification settings - Fork 8
/
trepan.pl
executable file
·69 lines (57 loc) · 1.94 KB
/
trepan.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
#!/usr/bin/env perl
# Copyright (C) 2012 Rocky Bernstein <rocky@cpan.org>
# Standalone routine to invoke a Perl program under the debugger.
# The usual boilerplate...
use strict; use warnings; use English qw( -no_match_vars );
use File::Basename; use File::Spec;
use File::Temp qw(tempfile);
my $dirname = dirname(__FILE__);
my $file = File::Spec->rel2abs(__FILE__);
my $TREPAN_DIR = File::Spec->catfile(dirname($file), '..', 'lib');
eval <<'EOE';
use lib $TREPAN_DIR;
use Devel::Trepan::Options;
use Devel::Trepan::Client;
use Devel::Trepan::Util;
use Data::Dumper;
EOE
die $EVAL_ERROR if $EVAL_ERROR;
my $opts = Devel::Trepan::Options::process_options(\@ARGV);
if ($opts->{client}) {
Devel::Trepan::Client::start_client({host=>$opts->{host},
port=>$opts->{port}});
exit;
}
my @exec_strs = @{$opts->{exec_strs}};
my @exec_strs_with_e = map {('-e', qq{'$_'})} @exec_strs;
my $cmd;
if (scalar @exec_strs) {
$cmd = join(' ', @exec_strs_with_e) . join(' ', @ARGV);
} else {
die "You need a Perl program to run or pass an string to eval"
unless @ARGV;
# Resolve program name if it is not readable
$ARGV[0] = whence_file($ARGV[0]) unless -r $ARGV[0];
$cmd = join(' ', @ARGV);
}
# Check that the debugged Perl program is syntactically valid.
my $syntax_errmsg = Devel::Trepan::Util::invalid_perl_syntax($cmd, 1);
if ($syntax_errmsg) {
print STDERR "$syntax_errmsg\n";
exit -1;
}
$opts->{dollar_0} = $ARGV[0];
$ENV{'TREPANPL_OPTS'} = Data::Dumper::Dumper($opts);
# print Dumper($opts), "\n";
# And just when you thought we'd never get around to actually
# doing something...
my @ARGS = ($EXECUTABLE_NAME, '-I', $TREPAN_DIR, '-d:Trepan',
@exec_strs_with_e, @ARGV);
#print Dumper(\@ARGS), "\n";
if ($OSNAME eq 'MSWin32') {
# I don't understand why but Strawberry Perl has trouble with exec.
system @ARGS;
exit $?;
} else {
exec { $ARGS[0]} @ARGS;
}