view release on metacpan or  search on metacpan

GDB.pm  view on Meta::CPAN

Unfortunately, the MI interface does not seem to support any kind
of I/O redirection, so this module helps you a bit, by setting the
C<exec-wrapper> variable with a console C<set> commmand. That is, this
module does soeQmthing like the following for you, providing proper file
descriptors for your actual stdin and stdout:

   set exec-wrapper <&5 >&6

The actual I/O redirection operators are also stored in C<< $gdb->{stdio}
>>, so you can even do it yourself, e.g. when providing your own wrapper:

   $self->cmd_raw ("set exec-wrapper $self->{stdio}", sub { });

(You need to use a raw command, as the "correct" C<gdb_set> MI command
silently ignores any C<exec-wrapper> setting).

=cut

package AnyEvent::GDB;

use common::sense;

use Carp ();
use Fcntl ();
use Scalar::Util ();

use AnyEvent ();
use AnyEvent::Util ();

our $VERSION = '0.2';

=head2 METHODS

=over 4

=item $gdb = new AnyEvent::GDB key => value...

Create a new GDB object using the given named parameters.

For initial experiments, it is highly recommended to run with tracing or
at least C<verbose> enabled. And don't forget to provide an C<on_eof>
callback.

   my $gdb = new AnyEvent::GDB
      on_eof => sub {
         print "We are done.\n";
      },
      trace => 1; # or verbose => 1, for less output

=over 4

=item exec => $path (default: "gdb")

The path of the GDB executable.

=item args => [$string...] (default: ["-n"])

An optional array of parameters to pass to GDB. This should not be
used to load a program executable, use the C<file_exec_and_symbols>,
C<target_attach> or similar MI commands instead.

=item trace => $boolean (default: 0)

If true, then all commands sent to GDB are printed to STDOUT prefixed with
"> ", and all replies received from GDB are printed to STDOUT prefixed
with "< ".

=item verbose => $boolean (default: true if trace is enabled, false otherwise)

If true, then log output and possibly other information is printed to
STDOUT.

=item on_xxxx => $callback->(...)

This specifies a callback for a specific event - see the L<EVENTS> section
later in this document.

=back

=cut

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      %arg,
   }, $class;

   my $exe = delete $self->{exec} // "gdb";
   my $arg = delete $self->{args} // [qw(-n)];

   $self->{verbose} = 1
      if $self->{trace} && !exists $self->{verbose};

   ($self->{fh}, my $fh2) = AnyEvent::Util::portable_socketpair;

   $self->{pid} = fork;

   open my $stdin , "<&STDIN" ;
   open my $stdout, ">&STDOUT";

   unless ($self->{pid}) {
      if (defined $self->{pid}) {
         open STDIN , "<&", $fh2;
         open STDOUT, ">&", $fh2;
         fcntl $stdin , Fcntl::F_SETFD, 0;
         fcntl $stdout, Fcntl::F_SETFD, 0;
         exec $exe, qw(--interpreter=mi2 -q), @$arg;
         kill 9, 0; # don't want to load the POSIX module just for this
      } else {
         Carp::croak "cannot fork: $!";
      }
   }

   AnyEvent::Util::fh_nonblocking $self->{fh}, 1;

   {
      Scalar::Util::weaken (my $self = $self);
      $self->{rw} = AE::io $self->{fh}, 0, sub {
         my $len = sysread $self->{fh}, $self->{rbuf}, 256, length $self->{rbuf};