Devel-hdb/lib/Devel/hdb/App/Control.pm
package Devel::hdb::App::Control;
use strict;
use warnings;
use base 'Devel::hdb::App::Base';
use Devel::hdb::App::Stack qw(_serialize_stack);
our $VERSION = '0.25';
__PACKAGE__->add_route('post', '/stepin', \&stepin);
__PACKAGE__->add_route('post', '/stepover', \&stepover);
__PACKAGE__->add_route('post', '/stepout', \&stepout);
__PACKAGE__->add_route('post', '/continue', \&continue);
__PACKAGE__->add_route('get', '/status', \&program_status);
__PACKAGE__->add_route('get', '/print_optree', \&print_optree);
sub stepin {
my($class, $app, $env) = @_;
$app->step;
return $class->_delay_status_return_to_client($app, $env);
}
sub stepover {
my($class, $app, $env) = @_;
$app->stepover;
return $class->_delay_status_return_to_client($app, $env);
}
sub stepout {
my($class, $app, $env) = @_;
$app->stepout;
return $class->_delay_status_return_to_client($app, $env);
}
sub continue {
my($class, $app, $env) = @_;
my $req = Plack::Request->new($env);
my $nostop = $req->param('nostop');
$app->continue;
if ($nostop) {
$app->disable_debugger();
$env->{'psgix.harakiri.commit'} = Plack::Util::TRUE;
return [ 204,
[$app->_parent_process_base_url
? ('Access-Control-Allow-Origin' => $app->_parent_process_base_url)
: ()
],
[],
];
}
return $class->_delay_status_return_to_client($app,$env);
}
sub program_status {
my($class, $app, $env) = @_;
my $status = $class->_program_status_data($app, $env);
return [ 200,
[ 'Content-Type' => 'application/json' ],
[ $app->encode_json($status) ] ];
}
sub _program_status_data {
my($class, $app, $env) = @_;
my $location = $app->current_location;
my $is_running = $location->at_end ? 0 : 1;
my $stack = $app->stack;
my %status = (
running => $is_running,
filename => $location->filename,
subroutine => $location->subroutine,
line => $location->line,
stack_depth => $stack->depth,
);
my $req = Plack::Request->new($env);
if ($req->param('next_statement')) {
local $@;
$status{next_statement} = eval { $app->next_statement };
if ($@) {
print STDERR "Trapped exception getting next statement: $@";
}
}
if (defined(my $next_fragment = $req->param('next_fragment'))) {
$status{next_fragment} = $app->next_fragment($next_fragment);
}
my $events = $app->dequeue_events;
if ($events and @$events) {
$status{events} = $events;
}
return \%status;
}
sub print_optree {
my($class, $app, $env) = @_;
my $loc = $app->current_location;
my $optree = $app->_get_optree_for_current_sub();
$optree->print_as_tree($loc->callsite);
}
sub _delay_status_return_to_client {
my($class, $app, $env) = @_;
return sub {
my $responder = shift;
my $writer = $responder->([ 200, [ 'Content-Type' => 'application/json' ]]);
$env->{'psgix.harakiri.commit'} = Plack::Util::TRUE;
my $cb = sub {
my $status = $class->_program_status_data($app, $env);
$writer->write( $app->encode_json($status) );
$writer->close();
};
$app->on_notify_stopped($cb);
};
}
1;
=pod
=head1 NAME
Devel::hdb::App::Control - Control execution of the debugged program
=head1 DESCRIPTION
Registers routes for methods to control execution of the debugged program
=head2 Routes
=over 4
=item GET /status
Get status information about the debugged program. Returns 200 and a
JSON-encoded hash in the body with these keys:
running => True if the program is running, false if terminated
subroutine => Name of the subroutine the program is stopped in
filename => Name of the file the program is stopped in
line => Line number the program is stopped on
stack_depth => How deep the program stack currently is
events => Array of program events since the last status report
For each event, there will be a hash describing the event. All events have
a 'type' key. The other keys are type-specific.
=over 2
=item fork
Immediately after the debugged program fork()s.
type => "fork"
pid => Child process ID
href => URL to communicate with the child process debugger
gui_href => URL to bring up the child process GUI
href_continue => URL to GET to tell the child to run without stopping
=item exception
When the program generates an uncaught exception
type => "exception"
value => Value of the exception
package => Location where the exception occurred
filename => ...
subroutine => ...
line => ...
=item watchpoint
When a watchpoint expression changes value. The location reported is
whichever line had executed immediately before the current program
line - likely the line that caused the change.
type => "watchpoint"
expr => Expression that changed value
old => Listref of the previous value
new => Listref of the new value
package => Location where the value was changed
filename => ...
subroutine => ...
line => ...
=item exit
When the program is terminating
type => "exit"
value => Program exit code
=item hangup
When the program is exiting and will not respond to further requests.
type => "hangup"
=item trace_diff
When run in follow mode and an execution difference has happened.
type => "trace_diff"
filename => Where the program is stopped now
line => ...
package => ...
subroutine => ...
sub_offset => ...
expected_filename => where the trace expected to be instead
expected_line => ...
expected_package => ...
expected_subroutine => ...
=back
=item POST /stepin
Causes the debugger to execute the current statement and pause before the
next. If the current statement involves a function call, execution stops
at the first line inside the called function.
Returns 200 and the same JSON hash as GET /status
=item POST /stepover
Causes the debugger to execute the current statement and pause before the
next. If the current statement involves function calls, these functions
are run to completion and execution stops before the next statement at
the current stack level. If execution of these functions leaves the current
stack frame, usually from an exception caught at a higher frame or a goto,
execution pauses at the first statement following the unwinding.
Returns 200 and the same JSON hash as GET /status
=item POST /steoput
Causes the debugger to start running continuously until the current stack
frame exits.
Returns 200 and the same JSON hash as GET /status
=item POST /continue
Causes the debugger to start running continuously until it encounters another
breakpoint.
Returns 200 and the same JSON hash as GET /status
=item POST /continue?nostop=1
Request the debugger continue execution. The param nostop=1 instructs the
debugger to run the program to completion and not stop at any breakpoints.
Returns 204 if successful.
=back
C</status>, C</stepin>, C</stepover>, C</stepout> and C<continue> accept
either or both of these optional parameters
=over 2
=item next_statement=1
The returned status hash includes a C<next_statement> key whose value
is a string representation of the next Perl statement to execute.
=item next_fragment=<integer>
The returned status hash includes a C<next_fragment> key whose value
is a string representation of the immediately-next opcode to execute.
The integer value is the number of parents of the current opcode to go
up before starting to deparse. 0 means to deparse only the current opcode;
1 means to deparse the current opcode's parent and that parent's children.
=back
=head1 SEE ALSO
L<Devel::hdb>
=head1 AUTHOR
Anthony Brummett <brummett@cpan.org>
=head1 COPYRIGHT
Copyright 2018, Anthony Brummett. This module is free software. It may
be used, redistributed and/or modified under the same terms as Perl itself.