File Coverage

blib/lib/DBGp/Client/Connection.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package DBGp::Client::Connection;
2              
3 2     2   67193 use strict;
  2         2  
  2         46  
4 2     2   5 use warnings;
  2         2  
  2         40  
5              
6             =head1 NAME
7              
8             DBGp::Client::Connection - DBGp connection class
9              
10             =head1 SYNOPSIS
11              
12             $connection = $listener->accept;
13              
14             $res = $connection->send_command('step_over');
15             die $res->message if $res->is_error;
16              
17             $res = $connection->send_command('eval', '--', encode_base64('$var'));
18             die $res->message if $res->is_error;
19              
20             # assumes result is a scalar value, it should check ->children
21             print $res->result->value, "\n";
22              
23             =head1 DESCRIPTION
24              
25             Simple blocking interface for a DBGp connection.
26              
27             =head1 METHODS
28              
29             =cut
30              
31 2     2   287 use DBGp::Client::Stream;
  2         1  
  2         32  
32 2     2   321 use DBGp::Client::Parser;
  0            
  0            
33              
34             =head2 new
35              
36             $connection = DBGp::Client::Connection->new(
37             socket => $connected_socket,
38             );
39              
40             Usually called by L, not used directly.
41              
42             Creates a new connection object wrapping the passed-in socket; after
43             construction, call L to process the initialization message
44             sent by the debugger.
45              
46             =cut
47              
48             sub new {
49             my ($class, %args) = @_;
50             my $stream = DBGp::Client::Stream->new(socket => $args{socket});
51             my $self = bless {
52             stream => $stream,
53             sequence => 0,
54             init => undef,
55             on_stream => undef,
56             on_notification => undef,
57             }, $class;
58              
59             return $self;
60             }
61              
62             =head2 parse_init
63              
64             $init = $connection->parse_init;
65              
66             Usually called by L, not used directly.
67              
68             Parses the init message sent by the debugger, and returns a
69             L object.
70              
71             =cut
72              
73             sub parse_init {
74             my ($self) = @_;
75              
76             $self->{init} = DBGp::Client::Parser::parse($self->{stream}->get_line);
77             }
78              
79             =head2 send_command
80              
81             $res = $connection->send_command('step_over');
82             $res = $connection->send_command('eval', '--', 'base64-encoded-data');
83              
84             Sends a command to the debugger, parses the answer and returns it as a
85             response object (see L).
86              
87             It automatically adds the DBGp transaction id (C<-i> parameter) to the
88             command.
89              
90             Note that this method could block indefinitely.
91              
92             =cut
93              
94             sub send_command {
95             my ($self, $command, @args) = @_;
96              
97             $self->{stream}->put_line($command, '-i', ++$self->{sequence}, @args);
98              
99             for (;;) {
100             my $res = DBGp::Client::Parser::parse($self->{stream}->get_line);
101              
102             if ($res->is_oob) {
103             if ($res->is_stream && $self->{on_stream}) {
104             $self->{on_stream}->($res);
105             } elsif ($res->is_notification && $self->{on_notification}) {
106             $self->{on_notification}->($res);
107             }
108              
109             next;
110             } else {
111             die 'Mismatched transaction IDs: got ', $res->transaction_id,
112             ' expected ', $self->{sequence}
113             if $res && $res->transaction_id != $self->{sequence};
114              
115             return $res;
116             }
117             }
118             }
119              
120             =head2 on_stream
121              
122             $connection->on_stream(sub { ... });
123              
124             Set a callback for receiving redirected program output.
125              
126             The callback receives a L object.
127              
128             =head2 on_notification
129              
130             $connection->on_notification(sub { ... });
131              
132             Set a callback for receiving notifications.
133              
134             The callback receives a L object.
135              
136             =cut
137              
138             sub on_stream { $_[0]->{on_stream} = $_[1] }
139             sub on_notification { $_[0]->{on_notification} = $_[1] }
140              
141             1;
142              
143             __END__