| … | |
… | |
| 108 | #)} |
108 | #)} |
| 109 | |
109 | |
| 110 | sub send { |
110 | sub send { |
| 111 | my ($self, $data) = @_; |
111 | my ($self, $data) = @_; |
| 112 | |
112 | |
| 113 | print "s<$data>\n";#d# |
113 | print "> $data" |
|
|
114 | if $self->{verbose}; |
| 114 | |
115 | |
| 115 | $self->{wbuf} .= $data; |
116 | $self->{wbuf} .= $data; |
| 116 | $self->{ww} ||= AE::io $self->{fh}, 1, $self->{wcb}; |
117 | $self->{ww} ||= AE::io $self->{fh}, 1, $self->{wcb}; |
| 117 | } |
118 | } |
| 118 | |
119 | |
| … | |
… | |
| 215 | = notify_async |
216 | = notify_async |
| 216 | ); |
217 | ); |
| 217 | |
218 | |
| 218 | sub feed { |
219 | sub feed { |
| 219 | my ($self, $line) = @_; |
220 | my ($self, $line) = @_; |
| 220 | use Data::Dump; #d# |
|
|
| 221 | |
221 | |
| 222 | warn "parse<$line>\n";#d# |
222 | print "< $line\n" |
|
|
223 | if $self->{verbose}; |
| 223 | |
224 | |
| 224 | for ($line) { |
225 | for ($line) { |
| 225 | if (/^\(gdb\)\s*$/gc) { # docs say "(gdb)", but reality says "(gdb) " |
226 | if (/^\(gdb\)\s*$/gc) { # docs say "(gdb)", but reality says "(gdb) " |
| 226 | # nop |
227 | # nop |
| 227 | } else { |
228 | } else { |
| … | |
… | |
| 243 | } elsif (/\G([*+=])([^,]+)/gc) { # *exec-async, +status-async, =notify-async |
244 | } elsif (/\G([*+=])([^,]+)/gc) { # *exec-async, +status-async, =notify-async |
| 244 | my ($type, $class) = ($type_map{$1}, $2); |
245 | my ($type, $class) = ($type_map{$1}, $2); |
| 245 | |
246 | |
| 246 | my $results = /\G,/gc ? &_parse_results : {}; |
247 | my $results = /\G,/gc ? &_parse_results : {}; |
| 247 | |
248 | |
| 248 | $self->event ($type => $results); |
249 | $self->event ($type => $class, $results); |
|
|
250 | $self->event ($class => $results); |
| 249 | |
251 | |
| 250 | } elsif (/\G~"/gc) { |
252 | } elsif (/\G~"/gc) { |
| 251 | push @{ $self->{console_stream} }, &_parse_c_string; |
253 | push @{ $self->{console_stream} }, &_parse_c_string; |
| 252 | } elsif (/\G&"/gc) { |
254 | } elsif (/\G&"/gc) { |
| 253 | $self->event (log_stream => &_parse_c_string); |
255 | $self->event (log_stream => &_parse_c_string); |
| … | |
… | |
| 300 | |
302 | |
| 301 | =item $gdb->cmd ($command => [$option...], $parameter..., $cb->($class, $results, $console)) |
303 | =item $gdb->cmd ($command => [$option...], $parameter..., $cb->($class, $results, $console)) |
| 302 | |
304 | |
| 303 | Execute a MI command and invoke the callback with the results. |
305 | Execute a MI command and invoke the callback with the results. |
| 304 | |
306 | |
| 305 | C<$command> is a MI command name, with C<-> replaced by C<_> and without |
307 | C<$command> is a MI command name. The leading minus sign can be omitted, |
| 306 | the intiial C<->, i.e. the GDB MI command C<-file-exec-and-symbols> |
308 | and instead of minus signs, you can use underscores, i.e. all the |
| 307 | becomes C<file_exec_and_symbols>. |
309 | following command names are equivalent: |
|
|
310 | |
|
|
311 | "-break-insert" # as documented in the GDB manual |
|
|
312 | -break_insert # using underscores and _ to avoid having to quote |
|
|
313 | break_insert # ditto, when e.g. used to the left of a => |
|
|
314 | "break-insert" # no leading minus |
| 308 | |
315 | |
| 309 | The second argument is an optional array reference with options (i.e. it |
316 | The second argument is an optional array reference with options (i.e. it |
| 310 | can simply be missing). Each C<$option> is either an option name (similar |
317 | can simply be missing). Each C<$option> is either an option name (similar |
| 311 | rules as with command names, i.e. no initial C<-->) or an array reference |
318 | rules as with command names, i.e. no initial C<-->) or an array reference |
| 312 | with the first element being the option name, and the remaining elements |
319 | with the first element being the option name, and the remaining elements |
| … | |
… | |
| 332 | |
339 | |
| 333 | sub cmd { |
340 | sub cmd { |
| 334 | my $cb = pop; |
341 | my $cb = pop; |
| 335 | my ($self, $cmd, @arg) = @_; |
342 | my ($self, $cmd, @arg) = @_; |
| 336 | |
343 | |
| 337 | $cmd = "-$cmd "; |
344 | $cmd =~ s/^[\-_]?/_/; |
| 338 | $cmd =~ s/_/-/g; |
345 | $cmd =~ y/_/-/; |
|
|
346 | |
|
|
347 | $cmd .= " "; |
| 339 | |
348 | |
| 340 | my $opt = ref $arg[0] ? shift @arg : []; |
349 | my $opt = ref $arg[0] ? shift @arg : []; |
| 341 | |
350 | |
| 342 | for (@$opt) { |
351 | for (@$opt) { |
| 343 | $cmd .= "-"; |
352 | $cmd .= "-"; |
| … | |
… | |
| 376 | push @_, my $cv = AE::cv; |
385 | push @_, my $cv = AE::cv; |
| 377 | &cmd; |
386 | &cmd; |
| 378 | $cv->recv |
387 | $cv->recv |
| 379 | } |
388 | } |
| 380 | |
389 | |
|
|
390 | our %DEFAULT_ACTION = ( |
|
|
391 | on_log_stream => sub { |
|
|
392 | print "$_[0]\n"; |
|
|
393 | }, |
|
|
394 | ); |
|
|
395 | |
| 381 | sub event { |
396 | sub event { |
| 382 | my ($self, $event, @args) = @_; |
397 | my ($self, $event, @args) = @_; |
| 383 | |
398 | |
|
|
399 | # if ($self->{verbose}) { |
|
|
400 | # use Data::Dumper; |
|
|
401 | # print Data::Dumper |
|
|
402 | # ->new ([[$event, @args]]) |
|
|
403 | # ->Pair ("=>") |
|
|
404 | # ->Useqq (1) |
|
|
405 | # ->Indent (0) |
|
|
406 | # ->Terse (1) |
|
|
407 | # ->Quotekeys (0) |
|
|
408 | # ->Sortkeys (1) |
|
|
409 | # ->Dump, |
|
|
410 | # "\n"; |
|
|
411 | # } |
|
|
412 | |
|
|
413 | my $cb = $self->{"on_$event"} || $DEFAULT_ACTION{$event} |
|
|
414 | or return; |
|
|
415 | |
|
|
416 | $cb->(@args); |
| 384 | use Data::Dump; |
417 | # use Data::Dump; |
| 385 | ddx [$event, @args]; |
418 | # ddx [$event, @args]; |
| 386 | |
|
|
| 387 | } |
419 | } |
| 388 | |
420 | |
| 389 | =back |
421 | =back |
| 390 | |
422 | |
| 391 | =head1 SEE ALSO |
423 | =head1 SEE ALSO |
