My (very hacky) 'modal' 'MUD' client

mud-client.pl

#!/usr/bin/env perl
use strict;
use warnings;
use Term::ReadLine;
use IO::Socket::INET;

# ABSTRACT: A hacky modal 'telnet' client
#
# This is written to replace 'rlwrap telnet foo'
# so I can have my own custom keybindings. At the time
# of this writing I am working on a MUD. I am testing
# quests and map navigation, and 'n' enter 'e' enter
# 'e' enter, etc. gets pretty tedious after a while,
# so this client has some features to facilitate that.
# It has a 'normal' mode and an 'insert'  mode like Vim.
# Normal mode is activated with ` and will make it so
# pressing enter is no longer required after n/s/e/w/u/d
# (directions). Bindings for hjkl (like vim) is also
# supported.

die "Usage: $0 host [port]" unless @ARGV;

pipe my ($child, $parent);
$parent->autoflush(1);

my $fork = fork();

if ($fork == 0) {
    close $parent;
    my $socket = IO::Socket::INET->new(
        PeerAddr => $ARGV[0],
        PeerPort => $ARGV[1] || 6715,
        Reuse      => 1,
    ) or die "Failed: $!";
    $socket->autoflush(1);

    my $rin = my $ein = my $rout = my $eout = '';
    {
        vec($rin, fileno($_), 1) = 1 for $child, $socket;
        my $select = select($rout = $rin, undef, $eout = $ein, undef);

        my $valid = 0;

        if ($select == -1) {
            redo if $!{EAGAIN} or $!{EINTR};
        }
        if (vec($eout, fileno($socket), 1)) {
            warn "uh oh";
            last;
        }
        if (vec($rout, fileno($socket), 1)) {
            $| = 1;
            my $read = sysread($socket, my $buf, 4096);
            last if not defined $read or $read == 0;
            print $buf;
            $valid = 1;
        }
        if (vec($rout, fileno($child), 1)) {
            my $buf = readline($child);
            syswrite $socket, $buf;
            $valid = 1;
        }
        if (!$valid) {
            warn "uh oh";
            last;
        }
        redo;
    }
}
else {
    my $mode = 'insert';
    my $term = Term::ReadLine->new();
    die "Only Term::ReadLine::Gnu is supported"
        unless $term->ReadLine eq 'Term::ReadLine::Gnu';

    my %dispatch = (
        h => "w\n",
        j => "s\n",
        k => "n\n",
        l => "e\n",
        (map { $_ => "$_\n" } qw/n s e w u d/),
    );

    $term->add_defun('normal-mode', sub { $mode = 'normal' if $mode eq 'insert'  }, ord '`');
    $term->add_defun('insert-mode', sub {
            if ($mode eq 'normal') {
                $mode = 'insert';
            }
            else {
                $term->insert_text('i');
            }
        }, ord 'i');
    for my $key (keys %dispatch) {
        $term->add_defun(
            "dispatch-key-$key",
            sub {
                if ($mode eq 'normal') {
                    print $parent $dispatch{$key};
                }
                else {
                    $term->insert_text($key);
                }
                return;
            },
            ord $key,
        );
    }

    while (defined(my $input = $term->readline(''))) {
        print $parent "$input\n";
    }
}