File Coverage

blib/lib/Hypersonic/Event.pm

Criterion	Covered	Total	%
statement	32	56	57.1
branch	14	38	36.8
condition	2	17	11.7
subroutine	7	11	63.6
pod	6	7	85.7
total	61	129	47.2

package Hypersonic::Event;

use strict;
use warnings;
use 5.010;

our $VERSION = '0.19';

# Hypersonic::Event - Event backend registry and selection
#
# This module provides a central registry for event loop backends and
# automatic detection of the best available backend for the platform.
# All event loop implementations are JIT-compiled via XS::JIT::Builder.

# Backend registry - maps name to module
my %BACKENDS = (
    io_uring    => 'Hypersonic::Event::IOUring',     # Linux 5.1+ (fastest)
    epoll       => 'Hypersonic::Event::Epoll',       # Linux (fast)
    kqueue      => 'Hypersonic::Event::Kqueue',      # BSD/macOS (fast)
    iocp        => 'Hypersonic::Event::IOCP',        # Windows (fast, completion-based)
    event_ports => 'Hypersonic::Event::EventPorts',  # Solaris/illumos (fast)
    poll        => 'Hypersonic::Event::Poll',        # POSIX fallback
    select      => 'Hypersonic::Event::Select',      # Universal (Windows support)
);

# Priority order for auto-selection (first available wins).
#
# io_uring is first on Linux because it batches submissions through
# the SQ ring (one syscall per arm-poll batch vs one syscall per
# epoll_ctl), but as of 0.19 it operates in *readiness-only* mode -
# we use io_uring_prep_poll_add (level-triggered POLLIN) as a pure
# notification mechanism and let the main event loop's userspace
# accept()/recv() do the actual I/O, exactly like the epoll path.
#
# Pre-0.19 attempted to use io_uring's completion-based I/O
# (io_uring_prep_accept + io_uring_prep_recv) where the kernel did
# the I/O and returned the result via cqe->res, but that had two
# unfixable bugs:
#   (a) gen_get_fd discarded the accepted client_fd from cqe->res
#       for UD_ACCEPT and set fd=listen_fd, so the main loop's
#       accept(listen_fd) returned EAGAIN (kernel already had it)
#       and broke - leaking the connection.
#   (b) prep_recv used a single GLOBAL recv_buf shared across all
#       concurrent clients, corrupting each other's request data.
# This produced the "empty body + 18 SIGKILL cascade + 5140s
# wallclock" pattern in CPAN tester reports for Hypersonic 0.18 on
# cpansmoker-1023 (perl 5.38..5.43). The readiness-only design in
# 0.19 sidesteps both bugs.
#
# If a user's kernel doesn't behave as expected, the env var
# HYPERSONIC_EVENT_BACKEND=epoll (or any registered backend) and
# the constructor option `event_backend => 'epoll'` both override
# auto-detection.
my @PRIORITY = qw(io_uring epoll kqueue iocp event_ports poll select);

# Check if io_uring is available (Linux 5.1+ with liburing)
sub _has_io_uring {
    return 0 unless $^O eq 'linux';

    # Check kernel version >= 5.1
    my $ver = `uname -r 2>/dev/null` || '';
    my ($major, $minor) = $ver =~ /^(\d+)\.(\d+)/;
    return 0 unless $major && ($major > 5 || ($major == 5 && $minor >= 1));

    # Check for liburing.h in common locations
    for my $path (
        '/usr/include/liburing.h',
        '/usr/local/include/liburing.h',
        '/usr/include/x86_64-linux-gnu/liburing.h',
    ) {
        return 1 if -f $path;
    }

    return 0;
}

# Select best available backend for this platform
sub best_backend {
    my $class = shift;

    # Explicit override via env var. Useful for (a) developers who
    # know io_uring works on their kernel and want the throughput,
    # and (b) test runners that need to pin a known-good backend.
    # Validated against the registered backend list - a bogus value
    # falls back to auto-detection rather than dying, so a typo in
    # a user's shell rc doesn't blow up production.
    if (my $forced = $ENV{HYPERSONIC_EVENT_BACKEND}) {
        if ($BACKENDS{$forced}) {
            my $mod = $BACKENDS{$forced};
            eval "require $mod";
            return $forced if !$@ && $mod->available;
            # Fall through to auto-detect if the requested backend
            # isn't actually loadable / available on this host.
        }
    }

    # Windows prefers IOCP (falls back to select if unavailable)
    if ($^O eq 'MSWin32') {
        my $mod = $BACKENDS{iocp};
        eval "require $mod";
        return 'iocp' if !$@ && $mod->available;
        return 'select';
    }

    for my $name (@PRIORITY) {
        my $mod = $BACKENDS{$name} or next;

        # Try to load the module
        eval "require $mod";
        next if $@;

        # Check if it's available on this platform
        next unless $mod->available;

        return $name;
    }

    die "No event backend available for platform: $^O";
}

# Get backend module by name (loads if needed)
sub backend {
    my ($class, $name) = @_;
    $name //= $class->best_backend;

    my $mod = $BACKENDS{$name}
        or die "Unknown event backend: $name (available: " . join(', ', sort keys %BACKENDS) . ")";

    eval "require $mod" or die "Cannot load $mod: $@";

    die "$mod is not available on this platform"
        unless $mod->available;

    return $mod;
}

# List all backends that work on this system
sub available_backends {
    my $class = shift;
    my @available;

    for my $name (@PRIORITY) {
        my $mod = $BACKENDS{$name} or next;

        eval "require $mod";
        next if $@;

        push @available, $name if $mod->available;
    }

    return @available;
}

# Return the backend priority order
sub backend_priority {
    return @PRIORITY;
}

# List all registered backends (whether available or not)
sub all_backends {
    return sort keys %BACKENDS;
}

# Register a custom backend
sub register_backend {
    my ($class, $name, $module) = @_;

    die "Backend name required" unless $name;
    die "Module name required" unless $module;

    $BACKENDS{$name} = $module;

    return 1;
}

# Unregister a backend
sub unregister_backend {
    my ($class, $name) = @_;
    delete $BACKENDS{$name};
}

1;

__END__