view release on metacpan or  search on metacpan

GDB.pm  view on Meta::CPAN

   $cmd =~ y/_/-/;

   $cmd .= " ";

   my $opt = ref $arg[0] ? shift @arg : [];

   for (@$opt) {
      $cmd .= "-";
      $cmd .= (_q $_) . " "
         for (ref) ? @$_ : $_;
   }

   # the MI syntax is inconsistent, providing "--" in case
   # parameters start with "-", but not allowing "-" as first
   # char of a parameter. in fact, "--" is flagged as unknown
   # option.
   if (@arg) {
#      $cmd .= "-- ";

      $cmd .= (_q $_) . " "
         for @arg;
   }

   # remove trailing " "
   substr $cmd, -1, 1, "";

   $self->cmd_raw ($cmd, $cb);
}

=item ($results, $console) = $gdb->cmd_sync ($command => [$option...], $parameter...])
=item $results = $gdb->cmd_sync ($command => [$option...], $parameter...])

Like C<cmd>, but blocks execution until the command has been executed, and
returns the results if sucessful. Croaks when GDB returns with an error.

This is purely a convenience method for small scripts: since it blocks
execution using a condvar, it is not suitable to be used inside callbacks
or modules.

That is, unless L<Coro> is used - with Coro, you can run multiple
C<cmd_sync> methods concurrently form multiple threads, with no issues.

=cut

sub cmd_sync {
   push @_, my $cv = AE::cv;
   &cmd;

   my ($class, $results, $console) = $cv->recv;

   Carp::croak $results->{msg}
      if $class eq "error";

   wantarray ? ($results, $console) : $results
}

sub event {
   my ($self, $event, @args) = @_;

#   if ($self->{verbose}) {
#      use Data::Dumper;
#      print Data::Dumper
#            ->new ([[$event, @args]])
#            ->Pair ("=>")
#            ->Useqq (1)
#            ->Indent (0)
#            ->Terse (1)
#            ->Quotekeys (0)
#            ->Sortkeys (1)
#            ->Dump,
#            "\n";
#   }

   my $cb;

   $cb = $self->can ("on_event")  and $cb->($self, $event, @args);
   $cb = $self->    {on_event}    and $cb->($self, $event, @args);
   $cb = $self->can ("on_$event") and $cb->($self, $event, @args);
   $cb = $self->    {"on_$event"} and $cb->($self, $event, @args);
}

# predefined events

sub on_notify_thread_group_added {
   my ($self, undef, $r) = @_;

   $self->{thread_group}{$r->{id}} = $r;
}

sub on_notify_thread_group_removed {
   my ($self, undef, $r) = @_;

   delete $self->{thread_group}{$r->{id}};
}

sub on_notify_thread_group_started {
   my ($self, undef, $r) = @_;

   delete $self->{thread_group}{exit_code};
   $self->{thread_group}{$r->{id}}{pid} = $r->{pid};
}

sub on_notify_thread_group_exited {
   my ($self, undef, $r) = @_;

   delete $self->{thread_group}{pid};
   $self->{thread_group}{$r->{id}}{exit_code} = $r->{exit_code};
}

sub on_notify_record_started {
   my ($self, undef, $r) = @_;

   $self->{thread_group}{$r->{id}}{recording} = 1;
}

sub on_notify_record_stopped {
   my ($self, undef, $r) = @_;

   $self->{thread_group}{$r->{id}}{recording} = 0;
}

sub on_notify_thread_created {