-
Notifications
You must be signed in to change notification settings - Fork 8
/
Options.pm
executable file
·243 lines (213 loc) · 8.18 KB
/
Options.pm
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
# Copyright (C) 2011, 2012 Rocky Bernstein <rocky@cpan.org>
use strict;
use warnings;
package Devel::Trepan::Options;
use Getopt::Long qw(GetOptionsFromArray);
use Pod::Usage;
use Pod::Find qw(pod_where);
use File::Spec;
use rlib '../..';
use vars qw(@EXPORT $DEFAULT_OPTIONS $PROGRAM_NAME);
@EXPORT = qw( process_options whence_file $DEFAULT_OPTIONS $PROGRAM_NAME);
our @ISA;
# Not used, but keeps the CPAN indexer happy
our $VERSION = 0.37;
BEGIN {
$PROGRAM_NAME = 'trepan.pl';
}
use constant PROGRAM_NAME => $PROGRAM_NAME;
@ISA = qw(Exporter);
# Return whether we want Terminal highlighting by default
sub default_term() {
($ENV{'TERM'} && ($ENV{'TERM'} ne 'dumb' ||
(exists($ENV{'EMACS'}) && $ENV{'EMACS'} eq 't')))
? 'term' : 0
}
my $home = $ENV{'HOME'} || glob("~");
my $initfile = File::Spec->catfile($home, '.treplrc');
$DEFAULT_OPTIONS = {
basename => 0,
batchfile => undef,
client => 0, # Set 1 if we want to connect to an out-of
# process debugger "server".
cmddir => [], # Additional directories of debugger commands
cmdfiles => [], # Files containing debugger commands to 'source'
exec_strs => [], # Perl strings to evaluate
fall_off_end => 0, # Don't go into debugger on termination?
highlight => default_term(),
# Default values used only when 'server' or 'client' # (out-of-process debugging)
host => 'localhost',
initfile => $initfile,
initial_dir => undef, # If --cd option was given, we save it here.
nx => 0, # Don't run user startup file (e.g. .treplrc)
port => 1954,
post_mortem => 0, # Go into debugger on die?
readline => 1, # Try to use GNU Readline?
testing => undef,
traceprint => 0, # set -x tracing?
};
sub show_version()
{
require Devel::Trepan;
printf "$PROGRAM_NAME, version %s\n", $Devel::Trepan::VERSION;
exit 10;
}
sub process_options($)
{
$Getopt::Long::autoabbrev = 1;
my ($argv) = @_;
my ($show_version, $help, $man);
my $opts = $DEFAULT_OPTIONS;
my $result = &GetOptionsFromArray($argv,
'basename' => \$opts->{basename},
'batch:s' => \$opts->{batchfile},
'bw' => \$opts->{bw},
'cd:s' => \$opts->{initial_dir},
'client' => \$opts->{client},
'cmddir=s@' => \$opts->{cmddir},
'command=s@' => \$opts->{cmdfiles},
'e|exec=s@' => \$opts->{exec_strs},
'fall-off-end' => \$opts->{fall_off_end},
'help' => \$help,
'highlight' => \$opts->{highlight},
'host:s' => \$opts->{host},
'man' => \$man,
'no-highlight' => sub { $opts->{highlight} = 0},
'no-readline' => sub { $opts->{readline} = 0},
'nx' => \$opts->{nx},
'port:n' => \$opts->{port},
'post-mortem' => \$opts->{post_mortem},
'readline' => \$opts->{readline},
'server' => \$opts->{server},
'testing:s' => \$opts->{testing},
'version' => \$show_version,
'x|trace' => \$opts->{traceprint},
);
pod2usage(-input => pod_where({-inc => 1}, __PACKAGE__),
-exitstatus => 1) if $help;
pod2usage(-exitstatus => 10, -verbose => 2,
-input => pod_where({-inc => 1}, __PACKAGE__)) if $man;
show_version() if $show_version;
chdir $opts->{initial_dir} || die "Can't chdir to $opts->{initial_dir}" if
defined($opts->{initial_dir});
my $batch_filename = $opts->{testing};
$batch_filename = $opts->{batchfile} unless defined $batch_filename;
if ($batch_filename) {
if (scalar(@{$opts->{cmdfiles}}) != 0) {
printf(STDERR "--batch option disables command files: %s\n",
join(', ', @{$opts->{cmdfiles}}));
$opts->{cmdfiles} = [];
}
$opts->{nx} = 1;
}
if ($opts->{server} and $opts->{client}) {
printf STDERR
"Pick only on from of the --server or --client options\n";
}
$opts;
}
# Do a shell-like path lookup for prog_script and return the results.
# If we can't find anything return the string given.
sub whence_file($)
{
my $prog_script = shift;
# If we have an relative or absolute file name, don't do anything.
return $prog_script if
File::Spec->file_name_is_absolute($prog_script);
my $first_char = substr($prog_script, 0, 1);
return $prog_script if index('./', $first_char) != -1;
for my $dirname (File::Spec->path()) {
my $prog_script_try = File::Spec->catfile($dirname, $prog_script);
return $prog_script_try if -r $prog_script_try;
}
# Failure
return $prog_script;
}
unless (caller) {
my $argv = \@ARGV;
my $opts = process_options($argv);
printf "whence file for perl: %s\n", whence_file('perl');
require Data::Dumper;
import Data::Dumper;
print Dumper($opts), "\n";
my $pid = fork();
if ($pid == 0) {
my @argv = qw(--version);
my $opts = process_options(\@argv);
exit 0;
} else {
waitpid($pid, 0);
print "exit code: ", $?>>8, "\n";
}
$pid = fork();
if ($pid == 0) {
my @argv = qw(--cd /tmp --cmddir /tmp);
my $opts = process_options(\@argv);
print Dumper($opts), "\n";
exit 0;
} else {
waitpid($pid, 0);
print "exit code: ", $?>>8, "\n";
}
exit;
$pid = fork();
if ($pid == 0) {
my @argv = qw(--cd /bogus);
my $opts = process_options(\@argv);
exit 0
} else {
waitpid($pid, 0);
print "exit code: ", $?>>8, "\n";
}
$pid = fork();
if ($pid == 0) {
my @argv = ('--batch', __FILE__);
my $opts = process_options(\@argv);
print Dumper($opts), "\n";
exit 0
} else {
waitpid($pid, 0);
print "exit code: ", $?>>8, "\n";
}
}
1;
__END__
=head1 TrepanPl
trepan.pl - Perl "Trepanning" Debugger
=head1 SYNOPSIS
trepan.pl [options] [[--] perl-program [perl-program-options ...]]
Options:
--help brief help message
--man full documentation
--basename Show basename only on source file listings.
(Needed in regression tests)
--bw Use Bullwinkle Processor (for front-ends) rather
that the command-line processor
-c| --command FILE Run or 'source' debugger command file FILE
--cmddir DIR Read DIR for additional debugger commands
--batch FILE Like --command, but quit after reading FILE.
This option has precidence over --command and
will also set --nx
--cd DIR Change current directory to DIR
-e| --exec STRING eval STRING. Multiple -e's can be given.
Works like Perl's -e switch
--nx Don't run user startup file (e.g. .treplrc)
--client | --server Set for out-of-process debugging. The server
rus the Perl program to be debugged runs.
The client runs outside of this process.
--fall-off-end Don't stay in debugger when program terminates
--host NAME Set DNS name or IP address to communicate on.
The default is 127.0.0.1
--port N TCP/IP port to use on remote connection
The default is 1954
--post-mortem Enter debugger on die
--readline | --no-readline
Try or don't try to use Term::Readline
-x|--trace Simulate line tracing (think POSIX shell set -x)
--highlight | --no-highlight
Use or don't use ANSI terminal sequences for syntax
highlight
=head1 DESCRIPTION
B<trepan.pl> is a gdb-like debugger. Much of the interface and code has
been adapted from the trepanning debuggers of Ruby.
=cut