use strict;
use warnings;
use 5.010;
use Cwd qw(cwd);
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
my %opt = (
port => 12345,
perl => $^X, # allow the user to supply the path to another perl
host => '127.0.0.1',
);
usage() if not @ARGV;
GetOptions(
\%opt,
'help',
'port=i',
'perl=s',
) or usage();
usage() if $opt{help};
my ( $script, @args ) = @ARGV;
my $pid = fork();
die if not defined $pid;
if ( not $pid ) {
local $ENV{PERLDB_OPTS} = "RemotePort=$opt{host}:$opt{port}";
exec("$opt{perl} -d $script @args");
}
say "PID: $pid";
#require IPC::Run;
require Debug::Client;
my $debugger = Debug::Client->new(
host => $opt{host},
port => $opt{port},
);
$debugger->listen;
say 'listening';
# my @cmd = ($opt{perl}, '-d', @ARGV);
# {
# local $ENV{PERLDB_OPTS} = "RemotePort=$opt{host}:$opt{port}";
# IPC::Run::run(\@cmd, sub {}, \&out, \&err);
# }
# say 'launched';
# sub out {
# print "OUT @_";
# }
# sub err {
# print "ERR @_";
# }
# my $process;
# if ($^O =~ /win32/i) {
# require Win32::Process;
# require Win32;
# local $ENV{PERLDB_OPTS} = "RemotePort=$opt{host}:$opt{port}";
# Win32::Process::Create($process, $opt{perl}, "-d $script @args", 0, 0, cwd);
# }
# print "launched " . $process->GetProcessID . "\n";
my $out = $debugger->get;
print $out;
my $last_step;
while (1) {
chomp( my $input = <STDIN> );
if ( $input eq '' ) {
next if not $last_step;
$input = $last_step;
}
given ($input) {
when ( [ 'h', '?' ] ) {
help();
}
when ('s') {
$last_step = 's';
my $out = $debugger->step_in;
print $out;
}
when ('n') {
$last_step = 'n';
my $out = $debugger->step_over;
print $out;
}
when ('r') {
my $out = $debugger->step_out;
print $out;
}
when ('T') {
my $out = $debugger->get_stack_trace;
print $out;
}
when ('.') {
my $out = $debugger->show_line;
print $out;
}
when ('q') {
last;
}
when (qr/^c (?:\s+(\w+))? $/x) {
my $out = $debugger->run($1);
print $out;
}
default {
#my $out = $debugger->execute_code($input);
#print $out;
print "Invalid command\n";
}
}
}
sub help {
print <<'END_HELP'
s - step in
n - step over
r - step out
T - stack trace
. - show current line
c (line|sub) - run till
q - quit
h or ? - help
END_HELP
}
# ...
# On Windows kill() does not seem to have effect
# print "Killing the script...\n";
END {
kill 9, $pid if $pid;
}
# Win32::Process
#$process->Kill(0);
sub usage {
pod2usage();
}
=head1 SYNOPSIS
script param param
--port PORT defaults to 12345
--help This help
--perl /path/to/other/perl defaults to current perl
=cut