view release on metacpan or  search on metacpan

lib/Acme/Parataxis/Compat.pm  view on Meta::CPAN

use v5.40;

package Acme::Parataxis::Compat v0.1.3 {
    use Errno       qw[EAGAIN EWOULDBLOCK];
    use IO::Handle  ();                       # loaded only: the overrides call IO::Handle::blocking() fully qualified
    use Carp        qw[croak];
    use Time::HiRes ();                       # loaded only: the overrides call Time::HiRes::time() fully qualified

    #
    # Transparent unblocking (CORE::GLOBAL overrides). This module is an opt-in
    # convenience: Acme::Parataxis->enable_transparent_unblocking() installs overrides
    # that make the blocking builtins `sleep`, `read` and `sysread` cooperative inside
    # scheduled fibers, and delegate to the raw CORE:: builtin everywhere else (top
    # level, foreign threads), so nothing outside the scheduler changes.
    #
    # The override subs are installed, not compiled with the module, so only code that
    # is *compiled after installation* is affected - exactly the gevent-style contract.
    # Every override calls the real builtin through its CORE:: name, so none of them can
    # recurse into themselves.
    #
    my $INSTALLED = 0;
    my @SAVED;    # [ name, saved-glob ] per installed override, for disable()

    # The readiness budget, in ms, that the read/sysread overrides give each await_read probe. A probe that comes
    # back short of it means a real wait timed out, so the override keeps waiting rather than block the process.
    my $PROBE_MS = 5000;

    # How much of that budget a probe has to burn before its -1 is read as "the handle is watchable, it just had
    # nothing to say" rather than "this platform cannot watch this handle at all". Win32's select() takes sockets
    # and nothing else, so a pipe or a regular file there answers -1 instantly, while a socket that truly timed out
    # takes the full budget. Anything under this fraction is the former.
    my $UNWATCHED = 0.9;

    # Write the framed read's result back into the caller's scalar (a reference to its
    # @_ slot), mimicking the builtin: undef (error) and 0 (EOF) leave the caller's
    # buffer alone; otherwise bytes before OFFSET are preserved and the read data is
    # placed at OFFSET.
    sub _store ( $slot, $off, $rc, $buf ) {
        return undef unless defined $rc;
        return 0 if 0 == $rc;
        $$slot = ( $off ? substr( $$slot // '', 0, $off ) : q{} ) . $buf;
        return $rc;
    }

    # Put a handle into non-blocking mode, answering the mode it was in, or undef when the platform will not.
    sub _try_nonblocking ($fh) {

        # `blocking` with no argument reports the current mode, and undef is its answer for a handle it cannot
        # interrogate: an already-closed glob, a dirhandle, a driver-supplied handle - and on Win32, a socket.
        # Winsock's FIONBIO can *set* a socket's mode but has no way to report one, so there the save half of a
        # save/restore does not exist. Nothing is lost by asking rather than assuming a platform: on the one
        # platform that cannot answer, the answer this read needs is already "no mode change", because sysread
        # hands back a short count on its own (see _read_nonblocking).
        my $was = IO::Handle::blocking($fh);
        return undef unless defined $was;

        # The setter answers with the mode it *replaced*, and -1 when it could not do the job at all. -1 is true, so
        # the return cannot be read as a success flag the way an undef could be; comparing against -1 is what tells
        # the two apart.
        my $replaced = IO::Handle::blocking( $fh, 0 );
        return defined $replaced && $replaced >= 0 ? $was : undef;
    }

    # Put a handle back the way the caller had it. The caller's own mode is what the handle looks like to every other
    # bit of code that touches it, including code compiled *before* installation, which still gets a raw blocking read
    # from this same handle. Restoring is what keeps transparent unblocking transparent.
    sub _restore_blocking ( $fh, $was ) {
        IO::Handle::blocking( $fh, $was ? 1 : 0 );
        return;
    }

    # Perform one read on a handle that is already known to be readable, WITHOUT letting a
    # short read park the OS thread.
    #
    # This is the whole point of the exercise. Perl's read() builtin does not return when *one* byte is available,
    # it keeps going until it has the *requested count* - so "await_read says ready, now read" froze the entire run
    # the moment a caller asked for more bytes than the peer had sent. Every fiber stalled, and because the fiber