view release on metacpan or  search on metacpan

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

use strict;
use warnings;
package Devel::Debug::Server::Agent;

use Devel::Debug::Server;
use Devel::ebug;

use Time::HiRes qw(usleep nanosleep);
use File::Spec;

    use Data::Dumper;

my $ebug = undef;
my $programName = undef;
my $breakPointsVersion = -1; #the version of the breakpoints
my $lastEvalCommand = '';
my $lastEvalResult = '';
my %breakPointsToSet = ();

sub absoluteName($){
    my ($fileName)=@_;
    if (! File::Spec->file_name_is_absolute( $fileName )){
        $fileName = File::Spec->rel2abs( $fileName ) ;
    }
    return $fileName;
}

#keep the breakpoint list up-to-date with the debug server
sub updateBreakPoints {
    my ($breakPointsServerVersion,$breakPointsList) = @_;

    if ($breakPointsServerVersion == $breakPointsVersion){
        return; #first check if there were no modification since last time
    }

    $breakPointsVersion = $breakPointsServerVersion;
    my @breakPoints = $ebug->all_break_points_with_condition();
    foreach my $breakPoint (@breakPoints) {

        my $file = absoluteName($breakPoint->{filename});
        my $line = $breakPoint->{line}; 
        my $condition = $breakPoint->{condition}; 
        #suppress all breakpoints already set but no more needed
        if (!(exists $breakPointsList->{$file} 
            && exists $breakPointsList->{$file}{$line})){
            $ebug->break_point_delete($file,$line);
        }
    }

    my $effectiveBreakpointList = [];

    my @loadedFilenames    = ();
    foreach my $loadedFile ($ebug->filenames()){
       push @loadedFilenames, absoluteName($loadedFile); 
    }
    
    #clean old list that will be rebuilt
    %breakPointsToSet = () ;
    #add all new breakpoints
    foreach my $file (keys %$breakPointsList) {
        if (grep {$_ eq $file} @loadedFilenames){
            my $bkPointList = setBreakPointForFile($file,keys %{$breakPointsList->{$file}});
            push @{$effectiveBreakpointList}, @{$bkPointList};
        }else{
            #the source file has not yet been loaded, 
            #store breakpoints and break on file loadind
            $breakPointsToSet{$file} = $breakPointsList->{$file} ;
            $ebug->break_on_load($file);
        }
    }
    sendBreakPointsInfo($effectiveBreakpointList);
    return;
}

# set breakpoints on newly loaded file $file
# return 1 if breakpoints were effectly set
# return 0 otherwise
sub setDelayedBreakPoints {
    my ($file) = @_;
    if (!exists $breakPointsToSet{$file}){
        return 0;
    }
    my $fileBreakPoints = $breakPointsToSet{$file};
    my $bkPointList = setBreakPointForFile($file,keys %{$fileBreakPoints});
    delete $breakPointsToSet{$file};
    sendBreakPointsInfo($bkPointList);
    return 1;
}