view release on metacpan or  search on metacpan

lib/App/mirai.pm  view on Meta::CPAN

 # start an IO::Async::Listener on the given port/socket file. Means the event loop needs to
 # be running, but should be able to hook into an existing application without too much trouble.
 # Some complications around Future nesting (Futures are created by the debugger itself) but
 # that's easy enough to work around
 perl -d:Mirai=localhost:1234 script.pl
 perl -d:Mirai=/tmp/mirai.sock script.pl
 
 # Run Tickit interface directly, presuming that the code itself is silent - everything is
 # in-process, so no need for debugging to go via pipes
 perl -Mirai script.pl
 
=head1 DESCRIPTION

Provides a basic debugging interface for tracing and interacting with L<Future>s. This should
allow you to see the L<Future> instances currently in use in a piece of code, and what their
current status is.

The UI is currently L<Tickit>-based.

=begin HTML

<p>Early preview screenshot:</p>
<p><img src="http://tickit.perlsite.co.uk/cpan-screenshot/mirai.png" alt="Mirai Tickit user interface" width="1024" height="550"></p>

=end HTML

There's a web interface in the works as well.

The name "mirai" (未来) was chosen because it's short and somewhat related to the concept
of the code, plus it seemed like a better option than chigiri (契り) at the time.

=cut

=head2 SERIALISATION

Defines the serialisation format to use.

Prefers L<Sereal> if available, will fall back to JSON via L<JSON::MaybeXS>. Set
C< MIRAI_SERIALISATION > in the environment to override:

=over 4

=item * Sereal

=item * JSON

=back

=cut

use constant SERIALISATION => $ENV{MIRAI_SERIALISATION} || (eval { require Sereal } ? 'Sereal' : 'JSON');

use Socket qw(AF_UNIX SOCK_STREAM PF_UNSPEC);
use IO::Handle;

# Everything after this point should happen at
# runtime only. That includes use/BEGIN/CHECK/INIT.
# use XYZ; will cause the module to be loaded in
# the child process, and it'd be nice to avoid that
# to keep the code-under-test as untainted as possible.

my ($child_pid);

# These are named for the entity doing the action, i.e.
# parent_write means parent will be doing the writing,
# child_read => child will read from this var.
my ($child_read, $parent_write);
my ($child_write, $parent_read);

my ($script);

=head1 METHODS

=cut

=head2 fork_child

Starts the child process for running the code-under-test.

=cut

sub fork_child {
	my ($self) = @_;
	# see perlipc
	socketpair $child_read, $parent_write, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die $!;
	socketpair $child_write, $parent_read, AF_UNIX, SOCK_STREAM, PF_UNSPEC or die $!;
	$child_write->autoflush(1);
	$parent_write->autoflush(1);

	unless($child_pid = fork // die) {
		require App::mirai::Subprocess;

		# Wait for permission to start
		my $line = <$child_read>;
		# $child_read->close or die $!;

		my $encoder = SERIALISATION eq 'JSON' ? JSON::MaybeXS->new(utf8 => 1) : Sereal::Encoder->new;
		App::mirai::Subprocess->setup(sub {
			eval {
				$child_write->print(pack 'N/a*', $encoder->encode(\@_));
			} or warn $@;

			# Single-step mode... not very efficient at all.
			my $line = <$child_read>;
		});

		if(!defined(do $script) && $@) {
			$child_write->print(
				pack 'N/a*', $encoder->encode([
					error => {
						location => $script,
						exception => $@
					}
				])
			);
		}

		$child_write->close or die $!;
		exit 0;
	}