The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/env perl
use strict;
use warnings;

use RPC::Async::Client;
use IO::EventMux;
use Data::Dumper;

if (@ARGV < 1) {
    die "Usage: $0 SERVER-SCRIPT [ SERVER-ARGUMENTS ]\n";
}
my ($server, @server_args) = @ARGV;

my $mux = IO::EventMux->new();
$mux->add(\*STDIN, Buffered => ['Split', qr/\n/]);

my $rpc = RPC::Async::Client->new($mux, $server, @server_args) or die;

my $stdin_open = 1;

while ($stdin_open or $rpc->has_requests) {
    my $event = $rpc->io($mux->mux) or next;
    my $type = $event->{type};

    if ($type eq "closed") {
        $stdin_open = 0;

    } elsif ($type eq "read") {
        my $line = $event->{data};

        my ($proc, @args);
        if ($line =~ /^(\w+)\s+(.*)$/) {
            $proc = $1;
            my @pairs = split /\s+/, $2;

            @args = eval {
                map { /^([^=]+)\s*=\s*(.*)$/ ? ($1, $2) : die } @pairs
            };
            if ($@) {
                print "Invalid args.\n";
                next;
            }

        } elsif ($line =~ /^(\w+)\s*$/x) {
            $proc = $1;

        } else {
            print "Invalid line: '$line'\n";
            next;
        }

        $rpc->call($proc, @args, sub {
                my @reply = @_;
                print "    $proc(", format_args(@args), ")\n";
                print " -> ", format_args(@reply), "\n";
            });
    }
}

$rpc->disconnect;

sub format_args {
    my $str = "";
    for (my $i = 0; $i < @_; $i += 2) {
        my $value = $_[$i+1];
        if (ref $value) {
            $value = Dumper($value);
            $value =~ s/^\$\w+\s*=\s*//;
        }
        $str .= ", " if $i > 0;
        $str .= $_[$i] ."=". $value
    }
    return $str;
}