view release on metacpan or  search on metacpan

lib/AnyEvent/Debug.pm  view on Meta::CPAN

Then you can use a tool to connect to the shell, such as the ever
versatile C<socat>, which in addition can give you readline support:

   socat readline /home/schmorp/shell
   # or:
   cd /home/schmorp; socat readline unix:shell

Socat can even give you a persistent history:

   socat readline,history=.anyevent-history unix:shell

Binding on C<127.0.0.1> (or C<::1>) might be a less secure but sitll not
totally insecure (on single-user machines) alternative to let you use
other tools, such as telnet:

   our $SHELL = AnyEvent::Debug::shell "127.1", "1357";

And then:

   telnet localhost 1357

=cut

sub shell($$) {
   local $TRACE = 0;

   AnyEvent::Socket::tcp_server $_[0], $_[1], sub {
      my ($fh, $host, $port) = @_;

      syswrite $fh, "Welcome, $host:$port, use 'help' for more info!\015\012> ";
      my $rbuf;

      my $logger = new AnyEvent::Log::Ctx
         log_cb => sub {
            syswrite $fh, shift;
            0
         };

      my $logger_guard = AnyEvent::Util::guard {
         $AnyEvent::Log::COLLECT->detach ($logger);
      };
      $AnyEvent::Log::COLLECT->attach ($logger);

      local $TRACE = 0;
      my $rw; $rw = AE::io $fh, 0, sub {
         my $len = sysread $fh, $rbuf, 1024, length $rbuf;

         $logger_guard if 0; # reference it

         if (defined $len ? $len == 0 : ($! != Errno::EAGAIN && $! != Errno::EWOULDBLOCK)) {
            undef $rw;
         } else {
            while ($rbuf =~ s/^(.*)\015?\012//) {
               my $line = $1;

               AnyEvent::fh_block $fh;

               if ($line =~ /^\s*exit\b/) {
                  syswrite $fh, "sorry, no... if you want to execute exit, try CORE::exit.\015\012";
               } elsif ($line =~ /^\s*coro\b\s*(.*)/) {
                  my $arg = $1;
                  if (eval { require Coro; require Coro::Debug }) {
                     if ($arg =~ /\S/) {
                        Coro::async (sub {
                           select $fh;
                           Coro::Debug::command ($arg);
                           local $| = 1; # older Coro versions do not flush
                           syswrite $fh, "> ";
                        });
                        return;
                     } else {
                        undef $rw;
                        syswrite $fh, "switching to Coro::Debug...\015\012";
                        Coro::async (sub { Coro::Debug::session ($fh) });
                        return;
                     }
                  } else {
                     syswrite $fh, "Coro not available.\015\012";
                  }

               } else {
                  package AnyEvent::Debug::shell;

                  no strict 'vars';
                  local $LOGGER = $logger;
                  my $old_stdout = select $fh;
                  local $| = 1;

                  my @res = eval $line;

                  select $old_stdout;
                  syswrite $fh, "$@" if $@;
                  syswrite $fh, "\015\012";

                  if (@res > 1) {
                     syswrite $fh, "$_: $res[$_]\015\012" for 0 .. $#res;
                  } elsif (@res == 1) {
                     syswrite $fh, "$res[0]\015\012";
                  }
               }

               syswrite $fh, "> ";
               AnyEvent::fh_unblock $fh;
            }
         }
      };
   }
}

{
   package AnyEvent::Debug::shell;

   our $LOGGER;

   sub help() {
      <<EOF
help         this command
wr [level]   sets wrap level to level (or toggles if missing)
v [level]    sets verbosity (or toggles between 0 and 9 if missing)
wl 'regex'   print wrapped watchers matching the regex (or all if missing)
i id,...     prints the watcher with the given ids in more detail
t            enable tracing for newly created watchers (enabled by default)
ut           disable tracing for newly created watchers
t  id,...    enable tracing for the given watcher (enabled by default)
ut id,...    disable tracing for the given watcher
w id,...     converts the watcher ids to watcher objects (for scripting)
coro xxx     run xxx as Coro::Debug shell command, if available
coro         switch to Coro::Debug shell, if available
EOF
   }

   sub wl(;$) {
      my $re = @_ ? qr<$_[0]>i : qr<.>;

      my %res;

      while (my ($k, $v) = each %AnyEvent::Debug::Wrapped) {
         my $s = "$v";
         $res{$s} = $k . (exists $v->{error} ? "*" : " ")
            if $s =~ $re;
      }

      join "", map "$res{$_} $_\n", sort keys %res
   }

   sub w {
      map {
         $AnyEvent::Debug::Wrapped{$_} || do {
            print "$_: no such wrapped watcher.\n";
            ()
         }
      } @_
   }

   sub i {
      join "",
         map $_->id . " $_\n" . $_->verbose . "\n",
            &w
   }

   sub wr {
      AnyEvent::Debug::wrap (@_);

      "wrap level now $AnyEvent::Debug::WRAP_LEVEL"
   }

   sub t {
      if (@_) {
         @_ = &w;
         $_->trace (1)
            for @_;
         "tracing enabled for @_."
      } else {
         $AnyEvent::Debug::TRACE = 1;
         "tracing for newly created watchers is now enabled."
      }
   }

   sub u {
      if (@_) {
         @_ = &w;
         $_->trace (0)
            for @_;
         "tracing disabled for @_."
      } else {
         $AnyEvent::Debug::TRACE = 0;
         "tracing for newly created watchers is now disabled."
      }