Devel-Debug-Server

 view release on metacpan or  search on metacpan

bin/debugServer.pl  view on Meta::CPAN

}

my $lastProcessCheck = [Time::HiRes::gettimeofday()];
sub checkProcessAlive(){
    if (Time::HiRes::tv_interval ( $lastProcessCheck)< 1){
        return; #nothing to do for now
    }

    foreach my $pid (keys %processesInfos){
        if (Time::HiRes::tv_interval ($processesInfos{$pid}{lastUpdateTime}) > 1.5 ){
             my $processSignaled = kill ( 0 => $pid); #send no signal to check process alive
             if ($processSignaled){
                $processesInfos{$pid}{lastUpdateTime} = [Time::HiRes::gettimeofday()];
             }
         }
    }
    $lastProcessCheck = [Time::HiRes::gettimeofday()];
}

#=method  propagateBreakPoints
#

lib/Devel/Debug/Server.pm  view on Meta::CPAN

One can launch one server and debug as many processes as he wants :
- all debugging informations are centralized by the server
- all debugging commands are sent by the server when it receives a client request

For example, the tests script "01-debug-script.t" launch a debug server and 3 processes. All processes are being debugged at the same time (breakpoints are set for all processes).

=head1 Architecture

There is one client process that send commands and retrieve data from the server process ; the tests scripts are client processes. 
Server process receives messages from the processes to debug and gives them commands. The server can also send signal in order to check if a process is alive or to halt it (like ctrl+C on perl debugger).
The processes to debug register automatically to the server on startup and wait for command (at least the run command).
All communications are managed using simple messages on localhost:5000 (zeroMq library).

    ------------------ ZMQ   ----------------  ZMQ   --------------------
    | client process | ----> |server process|<-------|process to debug 1|
    ------------------       |  (port 5000) |        --------------------
                             ----------------                       
                                            ^  ZMQ --------------------
                                            -------|process to debug 2|
                                                   --------------------

t/01-debug-script.t  view on Meta::CPAN

my $processToDebug = Proc::Background->new({'die_upon_destroy' => 1},$debugProcessCommand);
my $processToDebug2 = undef;
my $processToDebug3 = undef;
if (!$processToDebugOption){
    $processToDebug2 = Proc::Background->new({'die_upon_destroy' => 1},$processCommand);
    $processToDebug3 = Proc::Background->new({'die_upon_destroy' => 1},$processCommand);
}

sleep 1; #wait for processes to start

ok($procServer->alive(), "debug server is running");
ok($processToDebug->alive(), "process to debug is running");


sleep 1; #wait for processes to register to debug server

my $debugData = Devel::Debug::Server::Client::refreshData();

my @processesIDs = keys %{$debugData->{processesInfo}};

if (!$processToDebugOption){
    is(scalar @processesIDs,3,"we have 3 processes to debug");

t/01-debug-script.t  view on Meta::CPAN

Devel::Debug::Server::Client::removeBreakPoint($scriptPath,9);
Devel::Debug::Server::Client::run($processToDebugPID3);
$debugData = waitMilliSecondAndRefreshData(300);

$processInfos = $debugData->{processesInfo}{$processToDebugPID3};
is($processInfos->{halted},0, "process is running.");
my $updateTime = $processInfos->{lastUpdateTime};

$debugData = waitMilliSecondAndRefreshData(3000);
$processInfos = $debugData->{processesInfo}{$processToDebugPID3};
isnt(0,Time::HiRes::tv_interval($updateTime,$processInfos->{lastUpdateTime}),"process is running but we manage to check he's still alive");

Devel::Debug::Server::Client::suspend($processToDebugPID3);
$debugData = waitMilliSecondAndRefreshData(300);
$processInfos = $debugData->{processesInfo}{$processToDebugPID3};
is($processInfos->{halted},1, "process is halted after we send the suspend command.");

#clean up processes
undef $procServer;
undef $processToDebug;
undef $processToDebug2;

t/02-breakPointFileLoad.t  view on Meta::CPAN

my $debugServerCommand = "perl -I$FindBin::Bin/../lib $FindBin::Bin/../bin/debugServer.pl";
my $processCommand = "perl -I$FindBin::Bin/../lib $FindBin::Bin/../bin/debugAgent.pl $FindBin::Bin/load_calc.pl"; 


my $procServer = Proc::Background->new({'die_upon_destroy' => 1},$debugServerCommand);
my $processToDebug = Proc::Background->new({'die_upon_destroy' => 1},$processCommand);

sleep 1; #wait for processes to start

ok($procServer->alive(), "debug server is running");
ok($processToDebug->alive(), "process to debug is running");

sleep 1; #wait for processes to register to debug server

my $debugData = Devel::Debug::Server::Client::refreshData();

my @processesIDs = keys %{$debugData->{processesInfo}};

$processToDebugPID = $processesIDs[0];

my $modulePath = "$FindBin::Bin/Calc.pm";