Hypersonic
view release on metacpan or search on metacpan
- Fix io_uring backend to check for liburing library (not just headers)
- Add event backend ldflags to XS compile options
- Fix test race conditions with active port probing instead of sleep()
- Fix OpenSSL check to verify library is actually linkable
- Fix zlib check to verify library is actually linkable
- Fix SSE test includes for FreeBSD/BSD compatibility
0.08 2026-01-28
- Add Hypersonic::UA HTTP client with JIT-compiled XS
- Optional feature compilation (async, parallel, tls, http2, compression)
- Connection pooling with keep-alive support
- Async request support (currently only kqueue/epoll supported)
- Benchmark static get against python, rust and go.
0.07 2026-01-28
- Adds c_helpers for reusable c functions
- Adds need_xs_builder as an endpoint feature...
- Refactor Future::Pool so you can have more than one
- Centralise the caching
- Be a little more JIT but some improvements can still be made..
- Static routes still ~290K req/sec, dynamic routes call Perl per-request
0.01 2025-01-26
- Initial release
- JIT-compiled XS functions via XS::JIT (not Perl custom ops)
- Handlers run once at compile time, full HTTP responses baked into C
- Pure C event loop (kqueue on macOS/BSD, epoll on Linux)
- ~290K requests/second on single core
- Zero Perl in the hot path - recv/dispatch/send all in C
- Support for GET, POST, PUT, DELETE, PATCH, HEAD, OPTIONS
- Keep-alive connection support
- TCP_NODELAY for low latency
t/2010-ua-async-api.t
t/2011-ua-blocking-methods.t
t/2012-ua-async-future.t
t/2013-ua-run-poll.t
t/2014-ua-callback.t
t/2015-ua-start-request.t
t/2016-ua-state-machine.t
t/2017-ua-helpers.t
t/2100-ua-integration.t
t/2101-ua-async-integration.t
t/2102-ua-keepalive.t
t/2103-ua-minimal-compile.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
bench/wrk.pl view on Meta::CPAN
print "-" x 60, "\n";
for my $r (@results) {
my $relative = $r->{rps} / $baseline;
printf "%-20s %15.0f %12.2f %9.1fx\n",
$r->{name}, $r->{rps}, $r->{latency}, $relative;
}
}
print "\n";
print "Note: wrk uses connection pooling (keep-alive) for maximum throughput.\n";
print "Run with: perl bench/wrk.pl [duration] [threads] [connections]\n";
lib/Hypersonic.pm view on Meta::CPAN
port => $opts{port} // 8080,
# TLS options
tls => $opts{tls} // 0,
cert_file => $opts{cert_file},
key_file => $opts{key_file},
# HTTP/2 support
http2 => $opts{http2} // 0,
# Security hardening options
max_connections => $opts{max_connections} // 10000,
max_request_size => $opts{max_request_size} // 8192,
keepalive_timeout => $opts{keepalive_timeout} // 30,
recv_timeout => $opts{recv_timeout} // 30,
# WebSocket JIT options - granular control
websocket_rooms => $opts{websocket_rooms} // 0, # Enable Room support
max_rooms => $opts{max_rooms} // 1000,
max_clients_per_room => $opts{max_clients_per_room} // 10000,
# Graceful shutdown
drain_timeout => $opts{drain_timeout} // 5,
# JIT extension points
c_helpers => $opts{c_helpers}, # User C helper functions
# Security headers (JIT optimized - pre-computed at compile time)
lib/Hypersonic.pm view on Meta::CPAN
# Build COMPLETE HTTP response via Protocol module (JIT at compile time)
my $security_hdrs = $self->{enable_security_headers}
? $self->_get_security_headers_string()
: '';
my $full_response = $PROTOCOL->build_response(
status => $status,
headers => $headers,
body => $body,
keep_alive => 1,
security_headers => $security_hdrs,
);
push @full_responses, $full_response;
$route->{response_idx} = $#full_responses;
} else {
# Dynamic route - store handler index and param info
push @dynamic_handlers, $route->{handler};
push @route_param_info, $route->{params};
$route->{handler_idx} = $#dynamic_handlers;
lib/Hypersonic.pm view on Meta::CPAN
# HTTP/2 support - include nghttp2 if enabled
if ($self->{http2}) {
require Hypersonic::Protocol::HTTP2;
Hypersonic::Protocol::HTTP2->gen_includes($builder);
}
# Security hardening configuration
my $max_connections = $self->{max_connections};
my $max_request_size = $self->{max_request_size};
my $keepalive_timeout = $self->{keepalive_timeout};
my $recv_timeout = $self->{recv_timeout};
my $drain_timeout = $self->{drain_timeout};
# Backend-specific defines
$builder->blank
->line($backend->defines)
->line("#define RECV_BUF_SIZE $max_request_size")
->line("#define MAX_CONNECTIONS $max_connections");
# Enable security headers macro if configured
if ($self->{enable_security_headers} && $has_dynamic) {
$builder->line('#define HYPERSONIC_SECURITY_HEADERS 1');
}
$builder
->line("#define KEEPALIVE_TIMEOUT $keepalive_timeout")
->line("#define RECV_TIMEOUT $recv_timeout")
->line("#define DRAIN_TIMEOUT $drain_timeout")
->blank;
# TLS-aware I/O macros - compile-time decision, zero runtime overhead
$builder->comment('TLS-aware I/O wrappers - compile-time branching')
->line('#ifdef HYPERSONIC_TLS')
->line('#define HYPERSONIC_SEND(fd, buf, len) do { \\')
->line(' TLSConnection* _tc = get_tls_connection(fd); \\')
->line(' if (_tc) tls_send(_tc, buf, len); \\')
lib/Hypersonic.pm view on Meta::CPAN
->line(' ret = deflate(&strm, Z_FINISH);')
->line(' compressed_len = strm.total_out;')
->line(' deflateEnd(&strm);')
->line(' if (ret != Z_STREAM_END || compressed_len >= input_len) return 0;')
->line(' *output = gzip_out_buf;')
->line(' return compressed_len;')
->line('}')
->blank;
}
# Connection tracking for keep-alive timeout - O(1) using fd as index
$builder->comment('Connection tracking - O(1) using fd as direct index')
->line('#define MAX_FD 65536')
->line('static time_t g_conn_time[MAX_FD];')
->line('static time_t g_current_time = 0;')
->blank
->line("static $inline void track_connection(int fd, time_t now) {")
->line(' if (fd >= 0 && fd < MAX_FD) {')
->line(' g_conn_time[fd] = now;')
->line(' g_active_connections++;')
->line(' }')
lib/Hypersonic.pm view on Meta::CPAN
# Declare a dummy events pointer to satisfy gen_wait signature
$builder->line('void* events = NULL;');
}
$builder->line('time_t last_cleanup = time(NULL);')
->line('int accepting = 1; /* Flag to control accepting new connections */')
->blank;
# Main event loop
$builder->while('!g_shutdown || g_active_connections > 0')
->comment('Use timeout for keep-alive cleanup and shutdown check');
# Backend-specific: Wait for events
$backend->gen_wait($builder, 'ev_fd', 'events', 'n', '1000');
$builder->blank
->comment('Check for graceful shutdown - stop accepting new connections')
->if('g_shutdown && accepting');
# Backend-specific: Remove listen socket from event loop
$backend->gen_del($builder, 'ev_fd', 'listen_fd');
$builder->line('accepting = 0;')
->endif
->blank
->comment('Get time once per event batch')
->line('time_t now = time(NULL);')
->line('g_current_time = now;')
->blank;
# Keep-alive cleanup
$builder->comment('Periodic keep-alive timeout cleanup')
->if('now - last_cleanup >= 5')
->declare('int', 'cleanup_i', '0')
->for('cleanup_i = 0', 'cleanup_i < MAX_FD', 'cleanup_i++')
->if('g_conn_time[cleanup_i] > 0')
->if('now - g_conn_time[cleanup_i] > KEEPALIVE_TIMEOUT')
->comment('Close idle connection')
->line('int idle_fd = cleanup_i;');
# Backend-specific: Remove idle connection
$backend->gen_del($builder, 'ev_fd', 'idle_fd');
lib/Hypersonic.pm view on Meta::CPAN
->comment('Disable Nagle')
->line('int one = 1;')
->line('setsockopt(client_fd, IPPROTO_TCP, TCP_NODELAY, &one, sizeof(one));')
->blank
->comment('Set receive timeout for security')
->line('struct timeval tv;')
->line('tv.tv_sec = RECV_TIMEOUT;')
->line('tv.tv_usec = 0;')
->line('setsockopt(client_fd, SOL_SOCKET, SO_RCVTIMEO, &tv, sizeof(tv));')
->blank
->comment('Track connection for keep-alive timeout')
->line('track_connection(client_fd, now);')
->blank
->comment('TLS handshake if enabled')
->line('#ifdef HYPERSONIC_TLS')
->line('if (tls_accept(client_fd) < 0) {')
->line(' close(client_fd);')
->line(' remove_connection(client_fd);')
->line(' continue;')
->line('}')
->line('#endif')
lib/Hypersonic.pm view on Meta::CPAN
# Reset WebSocket state if WebSocket routes exist
if ($analysis->{needs_websocket}) {
$builder->line('ws_reset(fd);');
}
$builder->line('remove_connection(fd);')
->line('continue;')
->endif
->blank
->comment('Update connection activity for keep-alive timeout')
->line('update_connection(fd, now);')
->blank
->line('recv_buf[len] = \'\\0\';')
->blank;
# WebSocket frame handling - JIT: only generate if WebSocket routes exist
if ($analysis->{needs_websocket}) {
$self->_gen_websocket_frame_handler($builder);
}
lib/Hypersonic.pm view on Meta::CPAN
->line(' HYPERSONIC_SEND(fd, dyn_resp, dyn_resp_len);')
->line('}')
->else
->line('HYPERSONIC_SEND(fd, resp, resp_len);')
->endif;
} else {
$builder->line('HYPERSONIC_SEND(fd, resp, resp_len);');
}
$builder->blank;
# Keep-alive check - delegates to Protocol module
$PROTOCOL->gen_keepalive_check($builder);
$builder->blank
->if('!keep_alive');
# Backend-specific: Remove from event loop on close
$backend->gen_del($builder, 'ev_fd', 'fd');
$builder->line('HYPERSONIC_CLOSE(fd);');
# Reset WebSocket state if WebSocket routes exist
if ($analysis->{needs_websocket}) {
$builder->line('ws_reset(fd);');
}
lib/Hypersonic.pm view on Meta::CPAN
$builder
->comment(' Build response with custom headers support')
->line(' static __thread char resp_buf[65536];')
->line(' int hdr_len;')
->line('#ifdef HYPERSONIC_SECURITY_HEADERS')
->line(' hdr_len = snprintf(resp_buf, 2048,')
->line(' "HTTP/1.1 %d %s\\r\\n"')
->line(' "Content-Type: %s\\r\\n"')
->line(' "Content-Length: %zu\\r\\n"')
->line(' "Connection: keep-alive\\r\\n"')
->line(' "%s",')
->line(' status, get_status_text(status), content_type, len, SECURITY_HEADERS);')
->line('#else')
->line(' hdr_len = snprintf(resp_buf, 512,')
->line(' "HTTP/1.1 %d %s\\r\\n"')
->line(' "Content-Type: %s\\r\\n"')
->line(' "Content-Length: %zu\\r\\n"')
->line(' "Connection: keep-alive\\r\\n",')
->line(' status, get_status_text(status), content_type, len);')
->line('#endif')
->blank
->comment(' Add custom headers from response (Location, Set-Cookie, etc.)')
->line(' if (custom_headers) {')
->line(' HE* entry;')
->line(' hv_iterinit(custom_headers);')
->line(' while ((entry = hv_iternext(custom_headers))) {')
->line(' I32 klen;')
->line(' const char* key = hv_iterkey(entry, &klen);')
lib/Hypersonic.pm view on Meta::CPAN
my $content = $file->{content};
my $mime = $file->{mime};
my $etag = $file->{etag};
my $max_age = $file->{max_age};
my $len = $file->{length};
# Build complete HTTP response at compile time
my $response = "HTTP/1.1 200 OK\r\n"
. "Content-Type: $mime\r\n"
. "Content-Length: $len\r\n"
. "Connection: keep-alive\r\n";
$response .= "Cache-Control: public, max-age=$max_age\r\n" if $max_age;
$response .= "ETag: \"$etag\"\r\n" if $etag;
# Add security headers
if ($self->{enable_security_headers}) {
$response .= $self->_get_security_headers_string();
}
$response .= "\r\n" . $content;
lib/Hypersonic.pm view on Meta::CPAN
Path to TLS private key file (PEM format). Required if C<tls> is enabled.
=item max_connections
Maximum number of concurrent connections. Default: C<10000>
=item max_request_size
Maximum request size in bytes. Default: C<8192>
=item keepalive_timeout
Keep-alive connection timeout in seconds. Default: C<30>
=item recv_timeout
Receive timeout in seconds. Default: C<30>
=item drain_timeout
Graceful shutdown drain timeout in seconds. Default: C<5>
=item enable_security_headers
lib/Hypersonic.pm view on Meta::CPAN
});
=head2 streaming
$server->get('/events' => sub {
my ($stream) = @_;
# Send SSE events
my $sse = $stream->sse;
$sse->event(type => 'update', data => 'Hello');
$sse->keepalive;
$sse->close;
}, { streaming => 1 });
Enable streaming responses for a route. The handler receives a
L<Hypersonic::Stream> object instead of returning a static response.
B<Stream Object Methods:>
=over 4
lib/Hypersonic.pm view on Meta::CPAN
Send an SSE event with optional type and id.
=item $sse->data($data)
Send a data-only event (no type field).
=item $sse->retry($ms)
Set client reconnection interval in milliseconds.
=item $sse->keepalive
Send a keepalive comment to prevent timeout.
=item $sse->comment($text)
Send an SSE comment.
=item $sse->close
Close the SSE stream.
=back
lib/Hypersonic.pm view on Meta::CPAN
my ($stream) = @_;
my $sse = $stream->sse;
$sse->retry(3000); # Reconnect after 3s
$sse->event(
type => 'notification',
data => '{"message":"New update!"}',
id => '12345',
);
# Keep connection alive...
$sse->keepalive;
}, { streaming => 1 });
=head2 Route Handler Options
All route methods accept an optional hashref as the third argument:
$server->get('/path' => sub { ... }, {
dynamic => 1, # Force dynamic handler
parse_query => 1, # Parse query string
parse_headers => 1, # Parse HTTP headers
lib/Hypersonic.pm view on Meta::CPAN
say "Has streaming: ", $analysis->{needs_streaming} ? "yes" : "no";
say "Has WebSocket: ", $analysis->{needs_websocket} ? "yes" : "no";
say "Has Rooms: ", $analysis->{needs_websocket_rooms} ? "yes" : "no";
=head2 dispatch
my $response = $server->dispatch($request_arrayref);
Dispatch a request and return the response. Primarily for testing.
Request is an arrayref: C<[method, path, body, keep_alive, fd]>
=head2 run
$server->run(port => 8080, workers => 4);
Start the HTTP server event loop.
B<Options:>
=over 4
lib/Hypersonic/Future.pm view on Meta::CPAN
->xs_preamble
->line('int i;')
->line('if (items != 2) croak("Usage: $future->then($code)");')
->line('int slot = SvIV(SvRV(ST(0)));')
->line('FutureContext *ctx = &future_registry[slot];')
->line('SV *code = ST(1);')
->line('int new_slot = future_alloc_slot();')
->line('if (new_slot < 0) croak("Future registry full");')
->line('FutureContext *new_ctx = &future_registry[new_slot];')
->line('new_ctx->cancel_target = slot;')
->line('/* Keep parent alive while child exists (for chaining) */')
->line('ctx->refcount++;')
->line('if (ctx->state == FUTURE_STATE_DONE) {')
->line(' dSP;')
->line(' ENTER; SAVETMPS;')
->line(' PUSHMARK(SP);')
->line(' for (i = 0; i < ctx->result_count; i++) XPUSHs(ctx->result_values[i]);')
->line(' PUTBACK;')
->line(' int count = call_sv(code, G_ARRAY);')
->line(' SPAGAIN;')
->line(' if (count > 0) {')
lib/Hypersonic/Future.pm view on Meta::CPAN
->line('} else {')
->line(' if (ctx->callback_count < MAX_CALLBACKS - 1) {')
->line(' FutureCallback *cb = &ctx->callbacks[ctx->callback_count++];')
->line(' cb->type = FUTURE_CB_DONE;')
->line(' cb->code = SvREFCNT_inc(code);')
->line(' cb->target_slot = new_slot;')
->line(' FutureCallback *fail_cb = &ctx->callbacks[ctx->callback_count++];')
->line(' fail_cb->type = FUTURE_CB_FAIL | FUTURE_CB_CANCEL;')
->line(' fail_cb->code = NULL;')
->line(' fail_cb->target_slot = new_slot;')
->line(' /* Keep child alive until parent resolves */')
->line(' new_ctx->refcount++;')
->line(' }')
->line('}')
->line('SV *new_slot_sv = newSViv(new_slot);')
->line('SV *new_ref = newRV_noinc(new_slot_sv);')
->line('sv_bless(new_ref, gv_stashpv("Hypersonic::Future", GV_ADD));')
->line('/* refcount already 1 from alloc_slot for Perl ref */')
->line('ST(0) = sv_2mortal(new_ref);')
->xs_return('1')
->xs_end;
lib/Hypersonic/Future.pm view on Meta::CPAN
->xs_preamble
->line('int i;')
->line('if (items != 2) croak("Usage: $future->catch($code)");')
->line('int slot = SvIV(SvRV(ST(0)));')
->line('FutureContext *ctx = &future_registry[slot];')
->line('SV *code = ST(1);')
->line('int new_slot = future_alloc_slot();')
->line('if (new_slot < 0) croak("Future registry full");')
->line('FutureContext *new_ctx = &future_registry[new_slot];')
->line('new_ctx->cancel_target = slot;')
->line('/* Keep parent alive while child exists (for chaining) */')
->line('ctx->refcount++;')
->line('if (ctx->state == FUTURE_STATE_FAILED) {')
->line(' dSP;')
->line(' ENTER; SAVETMPS;')
->line(' PUSHMARK(SP);')
->line(' if (ctx->fail_message) XPUSHs(sv_2mortal(newSVpv(ctx->fail_message, 0)));')
->line(' if (ctx->fail_category) XPUSHs(sv_2mortal(newSVpv(ctx->fail_category, 0)));')
->line(' PUTBACK;')
->line(' int count = call_sv(code, G_ARRAY);')
->line(' SPAGAIN;')
lib/Hypersonic/Future.pm view on Meta::CPAN
->line('} else {')
->line(' if (ctx->callback_count < MAX_CALLBACKS - 1) {')
->line(' FutureCallback *cb = &ctx->callbacks[ctx->callback_count++];')
->line(' cb->type = FUTURE_CB_FAIL;')
->line(' cb->code = SvREFCNT_inc(code);')
->line(' cb->target_slot = new_slot;')
->line(' FutureCallback *done_cb = &ctx->callbacks[ctx->callback_count++];')
->line(' done_cb->type = FUTURE_CB_DONE | FUTURE_CB_CANCEL;')
->line(' done_cb->code = NULL;')
->line(' done_cb->target_slot = new_slot;')
->line(' /* Keep child alive until parent resolves */')
->line(' new_ctx->refcount++;')
->line(' }')
->line('}')
->line('SV *new_slot_sv = newSViv(new_slot);')
->line('SV *new_ref = newRV_noinc(new_slot_sv);')
->line('sv_bless(new_ref, gv_stashpv("Hypersonic::Future", GV_ADD));')
->line('/* refcount already 1 from alloc_slot for Perl ref */')
->line('ST(0) = sv_2mortal(new_ref);')
->xs_return('1')
->xs_end;
lib/Hypersonic/Future.pm view on Meta::CPAN
->xs_preamble
->line('int i;')
->line('if (items != 2) croak("Usage: $future->finally($code)");')
->line('int slot = SvIV(SvRV(ST(0)));')
->line('FutureContext *ctx = &future_registry[slot];')
->line('SV *code = ST(1);')
->line('int new_slot = future_alloc_slot();')
->line('if (new_slot < 0) croak("Future registry full");')
->line('FutureContext *new_ctx = &future_registry[new_slot];')
->line('new_ctx->cancel_target = slot;')
->line('/* Keep parent alive while child exists (for chaining) */')
->line('ctx->refcount++;')
->line('if (ctx->state != FUTURE_STATE_PENDING) {')
->line(' dSP;')
->line(' ENTER; SAVETMPS;')
->line(' PUSHMARK(SP);')
->line(' PUTBACK;')
->line(' call_sv(code, G_DISCARD);')
->line(' FREETMPS; LEAVE;')
->line(' new_ctx->state = ctx->state;')
->line(' if (ctx->state == FUTURE_STATE_DONE && ctx->result_count > 0) {')
lib/Hypersonic/Future.pm view on Meta::CPAN
->line(' } else if (ctx->state == FUTURE_STATE_FAILED) {')
->line(' if (ctx->fail_message) new_ctx->fail_message = strdup(ctx->fail_message);')
->line(' if (ctx->fail_category) new_ctx->fail_category = strdup(ctx->fail_category);')
->line(' }')
->line('} else {')
->line(' if (ctx->callback_count < MAX_CALLBACKS) {')
->line(' FutureCallback *cb = &ctx->callbacks[ctx->callback_count++];')
->line(' cb->type = FUTURE_CB_READY;')
->line(' cb->code = SvREFCNT_inc(code);')
->line(' cb->target_slot = new_slot;')
->line(' /* Keep child alive until parent resolves */')
->line(' new_ctx->refcount++;')
->line(' }')
->line('}')
->line('SV *new_slot_sv = newSViv(new_slot);')
->line('SV *new_ref = newRV_noinc(new_slot_sv);')
->line('sv_bless(new_ref, gv_stashpv("Hypersonic::Future", GV_ADD));')
->line('/* refcount already 1 from alloc_slot for Perl ref */')
->line('ST(0) = sv_2mortal(new_ref);')
->xs_return('1')
->xs_end;
lib/Hypersonic/Protocol/HTTP1.pm view on Meta::CPAN
# Hypersonic::Protocol::HTTP1 - JIT code generation for HTTP/1.1 protocol
#
# This module provides compile-time code generation methods for HTTP/1.1
# protocol handling. All methods return C code strings or use XS::JIT::Builder
# to generate code. There is NO runtime overhead - everything is JIT compiled.
#
# HTTP/1.1 specific features handled here:
# - Text-based request parsing (GET /path HTTP/1.1\r\n)
# - CRLF delimiters (\r\n\r\n header/body separator)
# - Connection: keep-alive/close header
# - Response format (HTTP/1.1 200 OK\r\nHeader: Value\r\n\r\nBody)
our $VERSION = '0.12';
# Protocol identifier - used for version negotiation
sub protocol_id { 'HTTP/1.1' }
# HTTP version string for responses
sub version_string { 'HTTP/1.1' }
# Generate a complete HTTP/1.1 response at compile time
# Returns the full response string with headers and body
sub build_response {
my ($class, %args) = @_;
my $status = $args{status} // 200;
my $status_text = $args{status_text} // _status_text($status);
my $headers = $args{headers} // {};
my $body = $args{body} // '';
my $keep_alive = $args{keep_alive} // 1;
my $security_headers = $args{security_headers} // '';
my $ct = $headers->{'Content-Type'}
// (($body =~ /^\s*[\[{]/) ? 'application/json' : 'text/plain');
my $response = "HTTP/1.1 $status $status_text\r\n"
. "Content-Type: $ct\r\n"
. "Content-Length: " . length($body) . "\r\n"
. "Connection: " . ($keep_alive ? 'keep-alive' : 'close') . "\r\n";
# Add security headers if provided
$response .= $security_headers if $security_headers;
# Add custom headers
for my $h (keys %$headers) {
next if $h eq 'Content-Type' || $h eq 'Content-Length' || $h eq 'Connection';
$response .= "$h: $headers->{$h}\r\n";
}
lib/Hypersonic/Protocol/HTTP1.pm view on Meta::CPAN
# Build 404 response at compile time
sub build_404_response {
my ($class, %args) = @_;
my $security_headers = $args{security_headers} // '';
return $class->build_response(
status => 404,
status_text => 'Not Found',
body => 'Not Found',
keep_alive => 0, # Close on 404
security_headers => $security_headers,
);
}
# Generate C code for parsing HTTP method from request buffer
# Uses XS::JIT::Builder API for clean code generation
sub gen_method_parser {
my ($class, $builder, $analysis) = @_;
my %methods_used = %{$analysis->{methods_used} // {}};
lib/Hypersonic/Protocol/HTTP1.pm view on Meta::CPAN
->endif;
} else {
$builder->comment('OPTIMIZED: No body parsing needed')
->line('const char* body = "";')
->line('int body_len = 0;');
}
return $builder;
}
# Generate C code for keep-alive detection
sub gen_keepalive_check {
my ($class, $builder) = @_;
$builder->comment('HTTP/1.1: Check Connection header for keep-alive')
->line('int keep_alive = 1;') # HTTP/1.1 default is keep-alive
->if('len > 20')
->comment('Search for "Connection:" header (case-insensitive C or c)')
->line('const char* conn = strstr(recv_buf + 16, "onnection:");')
->if('conn && (conn[-1] == \'C\' || conn[-1] == \'c\')')
->if('strstr(conn, "close") || strstr(conn, "Close")')
->line('keep_alive = 0;')
->endif
->endif
->endif;
return $builder;
}
# Status code to text mapping (complete list)
sub _status_text {
my ($code) = @_;
lib/Hypersonic/Protocol/HTTP1.pm view on Meta::CPAN
->line(' case 401: status_str = "Unauthorized"; break;')
->line(' case 403: status_str = "Forbidden"; break;')
->line(' case 404: status_str = "Not Found"; break;')
->line(' case 500: status_str = "Internal Server Error"; break;')
->line(' case 503: status_str = "Service Unavailable"; break;')
->line(' }')
->line(' int len = snprintf(headers, sizeof(headers),')
->line(' "HTTP/1.1 %d %s\\r\\n"')
->line(' "Content-Type: %s\\r\\n"')
->line(' "Transfer-Encoding: chunked\\r\\n"')
->line(' "Connection: keep-alive\\r\\n"')
->line(' "\\r\\n",')
->line(' status, status_str, content_type);')
->line(' send(fd, headers, len, 0);')
->line('}')
->blank;
return $builder;
}
# Generate C code for sending a chunk (hex length + data + CRLF)
lib/Hypersonic/Protocol/HTTP1.pm view on Meta::CPAN
using XS::JIT::Builder. There is zero runtime overhead.
=head2 HTTP/1.1 Specifics
=over 4
=item * Text-based request format: C<GET /path HTTP/1.1\r\n>
=item * CRLF delimiters: C<\r\n> between headers, C<\r\n\r\n> before body
=item * Keep-alive: Default in HTTP/1.1, detected via C<Connection: close>
=item * Response format: Status line + headers + body
=back
=head1 METHODS
=head2 build_response(%args)
Build a complete HTTP/1.1 response string at compile time.
lib/Hypersonic/Protocol/HTTP1.pm view on Meta::CPAN
Generate C code for parsing HTTP method using XS::JIT::Builder.
=head2 gen_path_parser($builder)
Generate C code for parsing request path.
=head2 gen_body_parser($builder, %opts)
Generate C code for finding request body.
=head2 gen_keepalive_check($builder)
Generate C code for detecting Connection: close.
=head1 AUTHOR
Hypersonic Contributors
=cut
lib/Hypersonic/Protocol/SSE.pm view on Meta::CPAN
=head2 SSE Format (RFC 8895)
event: message
id: 123
data: Hello World
event: update
data: line 1
data: line 2
: this is a comment/keepalive
retry: 3000
=cut
# Content-Type for SSE
sub content_type { 'text/event-stream' }
# Generate C code for formatting SSE events
sub gen_event_formatter {
lib/Hypersonic/Protocol/SSE.pm view on Meta::CPAN
->line('buf[pos++] = \'\\n\';')
->endif
->blank
->line('return pos;')
->line('}')
->blank;
return $builder;
}
# Generate C code for keepalive comment
sub gen_keepalive {
my ($class, $builder) = @_;
$builder->comment('SSE: Format keepalive comment')
->line('static size_t format_sse_keepalive(char* buf, size_t buf_size) {')
->line(' return snprintf(buf, buf_size, ": keepalive\\n\\n");')
->line('}')
->blank;
return $builder;
}
# Generate C code for retry directive
sub gen_retry {
my ($class, $builder) = @_;
lib/Hypersonic/Protocol/SSE.pm view on Meta::CPAN
->line('}')
->blank;
return $builder;
}
# Generate C code for custom comment
sub gen_comment {
my ($class, $builder) = @_;
$builder->comment('SSE: Format comment (can be used for keepalive or metadata)')
->line('static size_t format_sse_comment(char* buf, size_t buf_size, const char* text) {')
->line(' return snprintf(buf, buf_size, ": %s\\n\\n", text);')
->line('}')
->blank;
return $builder;
}
# Generate all SSE C code
sub generate_c_code {
my ($class, $builder, $opts) = @_;
$class->gen_event_formatter($builder);
$class->gen_keepalive($builder);
$class->gen_retry($builder);
$class->gen_comment($builder);
return $builder;
}
# Perl-side event formatting (for compile-time or fallback)
sub format_event {
my ($class, %opts) = @_;
lib/Hypersonic/Protocol/SSE.pm view on Meta::CPAN
$output .= "data: $line\n";
}
}
# Blank line to end event
$output .= "\n";
return $output;
}
# Format keepalive
sub format_keepalive {
return ": keepalive\n\n";
}
# Format retry directive
sub format_retry {
my ($class, $ms) = @_;
return "retry: $ms\n\n";
}
# Format comment
sub format_comment {
lib/Hypersonic/Protocol/SSE.pm view on Meta::CPAN
=item * Blank line - Terminates the event
=back
Special directives:
=over 4
=item * C<retry: ms> - Sets reconnection delay in milliseconds
=item * C<: comment> - Comment line (ignored by client, used for keepalive)
=back
=head1 AUTHOR
Hypersonic Contributors
=cut
lib/Hypersonic/SSE.pm view on Meta::CPAN
package Hypersonic::SSE;
use strict;
use warnings;
use 5.010;
# Hypersonic::SSE - High-level Server-Sent Events API
#
# Wraps the streaming infrastructure to provide a clean SSE interface.
# Automatically handles headers, event formatting, and keepalives.
# Uses JIT-compiled XS for performance.
our $VERSION = '0.12';
use constant {
STATE_INIT => 0,
STATE_STARTED => 1,
STATE_FINISHED => 2,
};
use constant MAX_SSE_INSTANCES => 65536;
lib/Hypersonic/SSE.pm view on Meta::CPAN
id => '123',
);
$sse->close();
}, { streaming => 1 });
=head1 DESCRIPTION
Hypersonic::SSE provides a high-level API for sending Server-Sent Events.
It wraps a Hypersonic::Stream object and handles SSE-specific formatting,
headers, and keepalives.
=cut
# ============================================================
# XS Code Generation - ALL instance methods generated in C
# ============================================================
sub generate_c_code {
my ($class, $builder, $opts) = @_;
$opts //= {};
my $max = $opts->{max_sse_instances} // MAX_SSE_INSTANCES;
$builder->line('#include <time.h>')
->blank;
$class->gen_sse_registry($builder, $max);
$class->gen_sse_reset($builder);
$class->gen_sse_format_event($builder);
$class->gen_sse_format_keepalive($builder);
$class->gen_sse_format_retry($builder);
$class->gen_sse_format_comment($builder);
# XS instance methods
$class->gen_xs_new($builder);
$class->gen_xs_stream($builder);
$class->gen_xs_is_started($builder);
$class->gen_xs_event_count($builder);
$class->gen_xs_last_event_time($builder);
$class->gen_xs_needs_keepalive($builder);
$class->gen_xs_event($builder);
$class->gen_xs_data($builder);
$class->gen_xs_retry($builder);
$class->gen_xs_keepalive($builder);
$class->gen_xs_comment($builder);
$class->gen_xs_close($builder);
return $builder;
}
sub gen_sse_registry {
my ($class, $builder, $max) = @_;
$builder->comment('SSE instance registry - stores SSE state')
->line('#define SSE_MAX ' . $max)
->line('#define SSE_STATE_INIT 0')
->line('#define SSE_STATE_STARTED 1')
->line('#define SSE_STATE_FINISHED 2')
->blank
->line('typedef struct {')
->line(' SV* stream_sv;')
->line(' int state;')
->line(' int event_count;')
->line(' time_t last_event_time;')
->line(' int keepalive_interval;')
->line('} SSEState;')
->blank
->line('static SSEState sse_registry[SSE_MAX];')
->line('static int sse_next_id = 0;')
->blank;
}
sub gen_sse_reset {
my ($class, $builder) = @_;
$builder->line('static void sse_reset(int id) {')
->line(' if (sse_registry[id].stream_sv) {')
->line(' SvREFCNT_dec(sse_registry[id].stream_sv);')
->line(' }')
->line(' memset(&sse_registry[id], 0, sizeof(SSEState));')
->line(' sse_registry[id].last_event_time = time(NULL);')
->line(' sse_registry[id].keepalive_interval = 30;')
->line('}')
->blank;
}
sub gen_sse_format_event {
my ($class, $builder) = @_;
$builder->comment('SSE: Format an event into buffer')
->comment('Returns bytes written')
->line('static size_t sse_format_event(char* buf, size_t buf_size,')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->line('buf[pos++] = \'\\n\';')
->endif
->blank
->line('return pos;')
->line('}')
->blank;
return $builder;
}
sub gen_sse_format_keepalive {
my ($class, $builder) = @_;
$builder->comment('SSE: Format keepalive comment')
->line('static size_t sse_format_keepalive(char* buf, size_t buf_size) {')
->line(' return snprintf(buf, buf_size, ": keepalive\\n\\n");')
->line('}')
->blank;
return $builder;
}
sub gen_sse_format_retry {
my ($class, $builder) = @_;
$builder->comment('SSE: Format retry directive')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->blank
->line('sse_reset(id);')
->blank
->comment('First arg after class is the stream object')
->if('items >= 2')
->line('sse_registry[id].stream_sv = newSVsv(ST(1));')
->else
->line('croak("Hypersonic::SSE->new requires a stream argument");')
->endif
->blank
->comment('Parse optional hash args: keepalive => N')
->for('int i = 2', 'i < items', 'i += 2')
->if('i + 1 < items')
->line('STRLEN klen;')
->line('const char* key = SvPV(ST(i), klen);')
->if('klen == 9 && strncmp(key, "keepalive", 9) == 0')
->line('sse_registry[id].keepalive_interval = SvIV(ST(i + 1));')
->endif
->endif
->endfor
->blank
->line('SV* id_sv = newSViv(id);')
->line('SV* ref = newRV_noinc(id_sv);')
->line('sv_bless(ref, gv_stashpv("Hypersonic::SSE", GV_ADD));')
->line('ST(0) = sv_2mortal(ref);')
->line('XSRETURN(1);')
->xs_end
lib/Hypersonic/SSE.pm view on Meta::CPAN
->check_items(1, 1, '$sse->last_event_time')
->line('int id = SvIV(SvRV(ST(0)));')
->if('id < 0 || id >= SSE_MAX')
->line('XSRETURN_IV(0);')
->endif
->line('XSRETURN_IV((IV)sse_registry[id].last_event_time);')
->xs_end
->blank;
}
sub gen_xs_needs_keepalive {
my ($class, $builder) = @_;
$builder->xs_function('xs_sse_needs_keepalive')
->xs_preamble
->check_items(1, 1, '$sse->needs_keepalive')
->line('int id = SvIV(SvRV(ST(0)));')
->if('id < 0 || id >= SSE_MAX')
->line('XSRETURN_NO;')
->endif
->blank
->comment('Check if stream is finished')
->line('SSEState* s = &sse_registry[id];')
->if('s->state >= SSE_STATE_FINISHED')
->line('XSRETURN_NO;')
->endif
->blank
->line('time_t now = time(NULL);')
->line('time_t elapsed = now - s->last_event_time;')
->if('elapsed >= s->keepalive_interval')
->line('XSRETURN_YES;')
->else
->line('XSRETURN_NO;')
->endif
->xs_end
->blank;
}
sub gen_xs_event {
my ($class, $builder) = @_;
lib/Hypersonic/SSE.pm view on Meta::CPAN
->line('dSP;')
->line('ENTER;')
->line('SAVETMPS;')
->line('PUSHMARK(SP);')
->line('XPUSHs(s->stream_sv);')
->line('XPUSHs(sv_2mortal(newSViv(200)));')
->comment('Create headers hash')
->line('HV* hv = newHV();')
->line('(void)hv_store(hv, "Content-Type", 12, newSVpv("text/event-stream", 0), 0);')
->line('(void)hv_store(hv, "Cache-Control", 13, newSVpv("no-cache", 0), 0);')
->line('(void)hv_store(hv, "Connection", 10, newSVpv("keep-alive", 0), 0);')
->line('(void)hv_store(hv, "X-Accel-Buffering", 17, newSVpv("no", 0), 0);')
->line('XPUSHs(sv_2mortal(newRV_noinc((SV*)hv)));')
->line('PUTBACK;')
->line('call_method("headers", G_DISCARD);')
->line('FREETMPS;')
->line('LEAVE;')
->line('s->state = SSE_STATE_STARTED;')
->endif
->blank
->comment('Parse event options from hash args')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->if('s->state == SSE_STATE_INIT && s->stream_sv')
->line('dSP;')
->line('ENTER;')
->line('SAVETMPS;')
->line('PUSHMARK(SP);')
->line('XPUSHs(s->stream_sv);')
->line('XPUSHs(sv_2mortal(newSViv(200)));')
->line('HV* hv = newHV();')
->line('(void)hv_store(hv, "Content-Type", 12, newSVpv("text/event-stream", 0), 0);')
->line('(void)hv_store(hv, "Cache-Control", 13, newSVpv("no-cache", 0), 0);')
->line('(void)hv_store(hv, "Connection", 10, newSVpv("keep-alive", 0), 0);')
->line('(void)hv_store(hv, "X-Accel-Buffering", 17, newSVpv("no", 0), 0);')
->line('XPUSHs(sv_2mortal(newRV_noinc((SV*)hv)));')
->line('PUTBACK;')
->line('call_method("headers", G_DISCARD);')
->line('FREETMPS;')
->line('LEAVE;')
->line('s->state = SSE_STATE_STARTED;')
->endif
->blank
->comment('Format data-only event')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->if('s->state == SSE_STATE_INIT && s->stream_sv')
->line('dSP;')
->line('ENTER;')
->line('SAVETMPS;')
->line('PUSHMARK(SP);')
->line('XPUSHs(s->stream_sv);')
->line('XPUSHs(sv_2mortal(newSViv(200)));')
->line('HV* hv = newHV();')
->line('(void)hv_store(hv, "Content-Type", 12, newSVpv("text/event-stream", 0), 0);')
->line('(void)hv_store(hv, "Cache-Control", 13, newSVpv("no-cache", 0), 0);')
->line('(void)hv_store(hv, "Connection", 10, newSVpv("keep-alive", 0), 0);')
->line('(void)hv_store(hv, "X-Accel-Buffering", 17, newSVpv("no", 0), 0);')
->line('XPUSHs(sv_2mortal(newRV_noinc((SV*)hv)));')
->line('PUTBACK;')
->line('call_method("headers", G_DISCARD);')
->line('FREETMPS;')
->line('LEAVE;')
->line('s->state = SSE_STATE_STARTED;')
->endif
->blank
->comment('Format retry directive')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->line('FREETMPS;')
->line('LEAVE;')
->endif
->blank
->line('ST(0) = ST(0);')
->line('XSRETURN(1);')
->xs_end
->blank;
}
sub gen_xs_keepalive {
my ($class, $builder) = @_;
$builder->xs_function('xs_sse_keepalive')
->xs_preamble
->check_items(1, 1, '$sse->keepalive')
->line('int id = SvIV(SvRV(ST(0)));')
->if('id < 0 || id >= SSE_MAX')
->line('ST(0) = ST(0);')
->line('XSRETURN(1);')
->endif
->blank
->line('SSEState* s = &sse_registry[id];')
->blank
->comment('Check if stream is finished')
->if('s->stream_sv')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->if('s->state == SSE_STATE_INIT && s->stream_sv')
->line('dSP;')
->line('ENTER;')
->line('SAVETMPS;')
->line('PUSHMARK(SP);')
->line('XPUSHs(s->stream_sv);')
->line('XPUSHs(sv_2mortal(newSViv(200)));')
->line('HV* hv = newHV();')
->line('(void)hv_store(hv, "Content-Type", 12, newSVpv("text/event-stream", 0), 0);')
->line('(void)hv_store(hv, "Cache-Control", 13, newSVpv("no-cache", 0), 0);')
->line('(void)hv_store(hv, "Connection", 10, newSVpv("keep-alive", 0), 0);')
->line('(void)hv_store(hv, "X-Accel-Buffering", 17, newSVpv("no", 0), 0);')
->line('XPUSHs(sv_2mortal(newRV_noinc((SV*)hv)));')
->line('PUTBACK;')
->line('call_method("headers", G_DISCARD);')
->line('FREETMPS;')
->line('LEAVE;')
->line('s->state = SSE_STATE_STARTED;')
->endif
->blank
->comment('Format keepalive')
->line('char buf[32];')
->line('size_t len = sse_format_keepalive(buf, sizeof(buf));')
->blank
->comment('Write to stream')
->if('s->stream_sv && len > 0')
->line('dSP;')
->line('ENTER;')
->line('SAVETMPS;')
->line('PUSHMARK(SP);')
->line('XPUSHs(s->stream_sv);')
->line('XPUSHs(sv_2mortal(newSVpvn(buf, len)));')
->line('PUTBACK;')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->if('s->state == SSE_STATE_INIT && s->stream_sv')
->line('dSP;')
->line('ENTER;')
->line('SAVETMPS;')
->line('PUSHMARK(SP);')
->line('XPUSHs(s->stream_sv);')
->line('XPUSHs(sv_2mortal(newSViv(200)));')
->line('HV* hv = newHV();')
->line('(void)hv_store(hv, "Content-Type", 12, newSVpv("text/event-stream", 0), 0);')
->line('(void)hv_store(hv, "Cache-Control", 13, newSVpv("no-cache", 0), 0);')
->line('(void)hv_store(hv, "Connection", 10, newSVpv("keep-alive", 0), 0);')
->line('(void)hv_store(hv, "X-Accel-Buffering", 17, newSVpv("no", 0), 0);')
->line('XPUSHs(sv_2mortal(newRV_noinc((SV*)hv)));')
->line('PUTBACK;')
->line('call_method("headers", G_DISCARD);')
->line('FREETMPS;')
->line('LEAVE;')
->line('s->state = SSE_STATE_STARTED;')
->endif
->blank
->comment('Format comment')
lib/Hypersonic/SSE.pm view on Meta::CPAN
->blank;
}
sub get_xs_functions {
return {
'Hypersonic::SSE::new' => { source => 'xs_sse_new', is_xs_native => 1 },
'Hypersonic::SSE::stream' => { source => 'xs_sse_stream', is_xs_native => 1 },
'Hypersonic::SSE::is_started' => { source => 'xs_sse_is_started', is_xs_native => 1 },
'Hypersonic::SSE::event_count' => { source => 'xs_sse_event_count', is_xs_native => 1 },
'Hypersonic::SSE::last_event_time' => { source => 'xs_sse_last_event_time', is_xs_native => 1 },
'Hypersonic::SSE::needs_keepalive' => { source => 'xs_sse_needs_keepalive', is_xs_native => 1 },
'Hypersonic::SSE::event' => { source => 'xs_sse_event', is_xs_native => 1 },
'Hypersonic::SSE::data' => { source => 'xs_sse_data', is_xs_native => 1 },
'Hypersonic::SSE::retry' => { source => 'xs_sse_retry', is_xs_native => 1 },
'Hypersonic::SSE::keepalive' => { source => 'xs_sse_keepalive', is_xs_native => 1 },
'Hypersonic::SSE::comment' => { source => 'xs_sse_comment', is_xs_native => 1 },
'Hypersonic::SSE::close' => { source => 'xs_sse_close', is_xs_native => 1 },
};
}
1;
__END__
=head1 CLIENT EXAMPLE
lib/Hypersonic/Socket.pm view on Meta::CPAN
->blank
->line('ssize_t len = recv((int)fd, recv_buf, RECV_BUF_SIZE - 1, 0);')
->blank
->if('len <= 0')
->line('ST(0) = &PL_sv_undef;')
->line('XSRETURN(1);')
->endif
->blank
->line('recv_buf[len] = \'\\0\';')
->blank
->comment('Quick parse - extract method, path, detect keep-alive')
->line('const char* p = recv_buf;')
->line('const char* end = recv_buf + len;')
->blank
->comment('Method')
->line('const char* method = p;')
->line('while (p < end && *p != \' \') p++;')
->line('int method_len = p - method;')
->if('p >= end')
->line('ST(0) = &PL_sv_undef;')
->line('XSRETURN(1);')
lib/Hypersonic/Socket.pm view on Meta::CPAN
->blank
->comment('Skip to end of request line')
->line('while (p < end && *p != \'\\n\') p++;')
->if('p >= end')
->line('ST(0) = &PL_sv_undef;')
->line('XSRETURN(1);')
->endif
->line('p++;')
->blank
->comment('Check for Connection: close')
->line('int keep_alive = 1;')
->line('while (p < end) {')
->line(' if (*p == \'\\r\' || *p == \'\\n\') break;')
->line(' if (end - p > 17 && strncasecmp(p, "Connection: close", 17) == 0) {')
->line(' keep_alive = 0;')
->line(' }')
->line(' while (p < end && *p != \'\\n\') p++;')
->line(' if (p < end) p++;')
->line('}')
->blank
->comment('Skip blank line')
->line('if (p < end && *p == \'\\r\') p++;')
->line('if (p < end && *p == \'\\n\') p++;')
->blank
->comment('Body')
->line('const char* body = p;')
->line('int body_len = end - p;')
->blank
->comment('Build request array: [method, path, body, keep_alive, fd]')
->line('AV* req = newAV();')
->line('av_push(req, newSVpvn(method, method_len));')
->line('av_push(req, newSVpvn(path, path_len));')
->line('av_push(req, newSVpvn(body, body_len));')
->line('av_push(req, newSViv(keep_alive));')
->line('av_push(req, newSViv(fd));')
->blank
->line('ST(0) = sv_2mortal(newRV_noinc((SV*)req));')
->xs_return('1')
->xs_end;
# Generate http_send - writev for zero-copy
$builder->xs_function('jit_http_send')
->xs_preamble
->line('if (items < 2 || items > 3) croak("Usage: http_send(fd, body, [content_type])");')
lib/Hypersonic/Socket.pm view on Meta::CPAN
->if('items == 3 && SvOK(ST(2))')
->line('STRLEN ct_len;')
->line('content_type = SvPV(ST(2), ct_len);')
->endif
->blank
->line('static __thread char header[512];')
->line('int hdr_len = snprintf(header, sizeof(header),')
->line(' "HTTP/1.1 200 OK\\r\\n"')
->line(' "Content-Type: %s\\r\\n"')
->line(' "Content-Length: %zu\\r\\n"')
->line(' "Connection: keep-alive\\r\\n\\r\\n",')
->line(' content_type, body_len);')
->blank
->line('struct iovec iov[2];')
->line('iov[0].iov_base = header;')
->line('iov[0].iov_len = (size_t)hdr_len;')
->line('iov[1].iov_base = (void*)body;')
->line('iov[1].iov_len = body_len;')
->blank
->line('ssize_t sent = writev((int)fd, iov, 2);')
->line('ST(0) = sv_2mortal(newSViv((IV)sent));')
lib/Hypersonic/Socket.pm view on Meta::CPAN
Accept a new connection on the listen socket.
Returns the client file descriptor, or -1 on error.
=head2 http_recv
my $request = Hypersonic::Socket::http_recv($fd);
Receive and quick-parse an HTTP request.
Returns an arrayref: C<[method, path, body, keep_alive, fd]>
=over 4
=item * C<method> - HTTP method (GET, POST, etc.)
=item * C<path> - Request path
=item * C<body> - Request body (for POST, PUT, etc.)
=item * C<keep_alive> - 1 if Connection: keep-alive, 0 otherwise
=item * C<fd> - Client file descriptor
=back
Uses zero-copy parsing for maximum speed.
=head2 http_send
Hypersonic::Socket::http_send($fd, $body, $content_type);
lib/Hypersonic/Stream.pm view on Meta::CPAN
my ($class, $builder) = @_;
$builder->line('static void stream_start_http1(int fd) {')
->line(' StreamState* s = &stream_registry[fd];')
->line(' char headers[2048];')
->line(' int len = snprintf(headers, sizeof(headers),')
->line(' "HTTP/1.1 %d %s\\r\\n"')
->line(' "Content-Type: %s\\r\\n"')
->line(' "%s"') # Extra headers (Cache-Control, etc.)
->line(' "Transfer-Encoding: chunked\\r\\n"')
->line(' "Connection: keep-alive\\r\\n\\r\\n",')
->line(' s->status, stream_status_text(s->status), s->content_type, s->extra_headers);')
->line(' send(fd, headers, len, 0);')
->line(' s->state = STREAM_STATE_STARTED;')
->line(' s->chunks_sent = 0;')
->line('}')
->blank;
}
sub gen_stream_write_chunk_c {
my ($class, $builder) = @_;
lib/Hypersonic/UA.pm view on Meta::CPAN
sub gen_ua_registry {
my ($class, $builder, $max) = @_;
$max //= MAX_CONNECTIONS;
$builder->line("#define UA_MAX_CONNECTIONS $max")
->line("#define UA_MAX_INSTANCES 256")
->line("#define DNS_CACHE_SIZE 64")
->line("#define CONN_POOL_SIZE 32")
->blank
->comment('Connection pool entry for keep-alive')
->line('typedef struct {')
->line(' int fd;')
->line(' char host[256];')
->line(' int port;')
->line(' time_t expires;')
->line('} PooledConn;')
->blank
->line("static PooledConn conn_pool[CONN_POOL_SIZE];")
->blank
->comment('Get a pooled connection if available')
lib/Hypersonic/UA.pm view on Meta::CPAN
->line(' if (conn_pool[i].fd > 0 && conn_pool[i].port == port &&')
->line(' strcmp(conn_pool[i].host, host) == 0 && conn_pool[i].expires > now) {')
->line(' int fd = conn_pool[i].fd;')
->line(' conn_pool[i].fd = 0;')
->line(' return fd;')
->line(' }')
->line(' }')
->line(' return -1;')
->line('}')
->blank
->comment('Return connection to pool (15 second keep-alive)')
->line('static void pool_put(int fd, const char *host, int port) {')
->line(' int i;')
->line(' time_t now = time(NULL);')
->line(' /* Find empty slot or expired entry */')
->line(' for (i = 0; i < CONN_POOL_SIZE; i++) {')
->line(' if (conn_pool[i].fd <= 0 || conn_pool[i].expires <= now) {')
->line(' if (conn_pool[i].fd > 0) close(conn_pool[i].fd);')
->line(' conn_pool[i].fd = fd;')
->line(' strncpy(conn_pool[i].host, host, 255);')
->line(' conn_pool[i].host[255] = 0;')
lib/Hypersonic/UA.pm view on Meta::CPAN
->line(' dns_cache[slot].addr = *addr_out;')
->line(' dns_cache[slot].expires = now + 60;')
->line(' return 1;')
->line('}')
->blank
->line('typedef struct {')
->line(' int in_use;')
->line(' int timeout_ms;')
->line(' int connect_timeout_ms;')
->line(' int max_redirects;')
->line(' int keep_alive;')
->line(' SV *default_headers;')
->line(' char *base_url;')
->line('} UAContext;')
->blank
->line("static UAContext ua_registry[UA_MAX_INSTANCES];")
->blank
->line('static int ua_alloc_slot(void) {')
->line(' int i;')
->line(' for (i = 0; i < UA_MAX_INSTANCES; i++) {')
->line(' if (!ua_registry[i].in_use) {')
lib/Hypersonic/UA.pm view on Meta::CPAN
->blank
->line('slot = ua_alloc_slot();')
->line('if (slot < 0) croak("Too many UA instances");')
->blank
->line('ctx = &ua_registry[slot];')
->blank
->comment('Defaults')
->line('ctx->timeout_ms = 30000;')
->line('ctx->connect_timeout_ms = 5000;')
->line('ctx->max_redirects = 5;')
->line('ctx->keep_alive = 1;')
->line('ctx->default_headers = NULL;')
->line('ctx->base_url = NULL;')
->blank
->comment('Parse options hash if provided')
->if('items >= 2 && SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVHV')
->line('opts = (HV *)SvRV(ST(1));')
->blank
->line('if ((val = hv_fetchs(opts, "timeout", 0)) && SvOK(*val)) ctx->timeout_ms = SvIV(*val);')
->line('if ((val = hv_fetchs(opts, "connect_timeout", 0)) && SvOK(*val)) ctx->connect_timeout_ms = SvIV(*val);')
->line('if ((val = hv_fetchs(opts, "max_redirects", 0)) && SvOK(*val)) ctx->max_redirects = SvIV(*val);')
->line('if ((val = hv_fetchs(opts, "keep_alive", 0)) && SvOK(*val)) ctx->keep_alive = SvTRUE(*val) ? 1 : 0;')
->line('if ((val = hv_fetchs(opts, "headers", 0)) && SvROK(*val)) ctx->default_headers = SvREFCNT_inc(*val);')
->if('(val = hv_fetchs(opts, "base_url", 0)) && SvOK(*val)')
->line('url = SvPV(*val, len);')
->line('ctx->base_url = (char *)malloc(len + 1);')
->line('memcpy(ctx->base_url, url, len + 1);')
->endif
->endif
->blank
->comment('Build array-based object')
->line('self = newAV();')
->line('av_extend(self, 6);')
->line('av_store(self, 0, newSViv(slot));')
->line('av_store(self, 1, newSViv(ctx->timeout_ms));')
->line('av_store(self, 2, newSViv(ctx->connect_timeout_ms));')
->line('av_store(self, 3, ctx->default_headers ? SvREFCNT_inc(ctx->default_headers) : newRV_noinc((SV *)newHV()));')
->line('av_store(self, 4, ctx->base_url ? newSVpv(ctx->base_url, 0) : &PL_sv_undef);')
->line('av_store(self, 5, newSViv(ctx->max_redirects));')
->line('av_store(self, 6, newSViv(ctx->keep_alive));')
->blank
->line('self_ref = newRV_noinc((SV *)self);')
->line('sv_bless(self_ref, gv_stashpv("Hypersonic::UA", GV_ADD));')
->blank
->line('ST(0) = sv_2mortal(self_ref);')
->xs_return('1')
->xs_end
->blank;
}
lib/Hypersonic/UA.pm view on Meta::CPAN
->line('SvCUR_set(request, rp - SvPVX(request));')
->line('ST(0) = sv_2mortal(request);')
->xs_return('1')
->xs_end
->blank;
}
sub gen_xs_get {
my ($class, $builder) = @_;
# Inlined HTTP GET with connection pooling and keep-alive
$builder->comment('GET request - with keep-alive connection pooling')
->comment('Usage: $ua->get($url) or $ua->get($url, sub { ... })')
->xs_function('xs_ua_get')
->xs_preamble
->line('if (items < 2) croak("Usage: $ua->get($url, [$cb])");')
->blank
->line('SV *self_sv = ST(0);')
->line('SV *url_sv = ST(1);')
->line('SV *cb = (items >= 3 && SvROK(ST(2)) && SvTYPE(SvRV(ST(2))) == SVt_PVCV) ? ST(2) : NULL;')
->blank
->comment('Parse URL')
lib/Hypersonic/UA.pm view on Meta::CPAN
->line('close(fd);')
->line('croak("DNS resolution failed for %s", host_buf);')
->endif
->blank
->if('connect(fd, (struct sockaddr *)&addr, sizeof(addr)) < 0')
->line('close(fd);')
->line('croak("connect() failed");')
->endif
->endif
->blank
->comment('Build HTTP GET request with keep-alive')
->line('char req_buf[4096];')
->line('int req_len = snprintf(req_buf, sizeof(req_buf),')
->line(' "GET %s HTTP/1.1\\r\\n"')
->line(' "Host: %s\\r\\n"')
->line(' "Connection: keep-alive\\r\\n"')
->line(' "User-Agent: Hypersonic/1.0\\r\\n"')
->line(' "\\r\\n",')
->line(' path, host_buf);')
->blank
->comment('Send request')
->line('if (send(fd, req_buf, req_len, 0) < 0) {')
->line(' close(fd);')
->line(' croak("send() failed");')
->line('}')
->blank
->comment('Receive response - need to parse Content-Length for keep-alive')
->line('char resp_buf[65536];')
->line('int resp_len = 0;')
->line('int headers_end = 0;')
->line('int content_length = -1;')
->line('int n;')
->blank
->comment('Read until we have headers')
->line('while (!headers_end && resp_len < (int)sizeof(resp_buf) - 1) {')
->line(' n = recv(fd, resp_buf + resp_len, sizeof(resp_buf) - resp_len - 1, 0);')
->line(' if (n <= 0) break;')
lib/Hypersonic/UA.pm view on Meta::CPAN
->line('int body_received = resp_len - headers_end;')
->line('while (body_received < content_length && resp_len < (int)sizeof(resp_buf) - 1) {')
->line(' n = recv(fd, resp_buf + resp_len, sizeof(resp_buf) - resp_len - 1, 0);')
->line(' if (n <= 0) break;')
->line(' resp_len += n;')
->line(' body_received += n;')
->line('}')
->endif
->line('resp_buf[resp_len] = 0;')
->blank
->comment('Return connection to pool if keep-alive')
->line('char *conn_hdr = strcasestr(resp_buf, "Connection:");')
->line('int keep_alive = 1;')
->if('conn_hdr && headers_end > 0 && conn_hdr < resp_buf + headers_end')
->line('if (strncasecmp(conn_hdr + 11, " close", 6) == 0) keep_alive = 0;')
->endif
->blank
->if('keep_alive && content_length >= 0')
->line('pool_put(fd, host_buf, port);')
->else
->line('close(fd);')
->endif
->blank
->comment('Parse response')
->line('HV *result = newHV();')
->blank
->comment('Extract status code')
->line('int status = 0;')
lib/Hypersonic/UA.pm view on Meta::CPAN
# Or fetch multiple URLs concurrently
my @futures = map { $ua->get_async($_) } @urls;
my $all = Hypersonic::Future->needs_all(@futures);
my @results = $all->result; # Automatically completes all requests
=head1 DESCRIPTION
C<Hypersonic::UA> is a high-performance HTTP client using JIT-compiled XS code.
It supports both blocking and async operations with connection pooling and
keep-alive support.
=head1 COMPILATION OPTIONS
Hypersonic::UA->compile(%options);
=over 4
=item async => 1
Enable async methods: C<get_async>, C<post_async>, C<tick>, C<run>, C<pending>.
lib/Hypersonic/UA.pm view on Meta::CPAN
Fetch multiple URLs, return first to complete.
=head1 PERFORMANCE
C<Hypersonic::UA> is designed for high-throughput async HTTP operations.
Key performance features:
=head2 Connection Pooling
Connections are automatically pooled and reused with HTTP keep-alive.
This eliminates the TCP handshake overhead for subsequent requests to
the same host, significantly improving throughput.
=head2 Event-Driven I/O
Uses the best available event backend (kqueue on macOS/BSD, epoll on Linux)
for efficient non-blocking I/O with minimal syscall overhead.
=head2 JIT-Compiled XS
lib/Hypersonic/UA.pm view on Meta::CPAN
my $elapsed = time() - $start;
printf "%d requests in %.3fs (%.0f req/sec)\n",
scalar(@responses), $elapsed, scalar(@responses) / $elapsed;
Typical results on modern hardware:
=over 4
=item * B<100,000+ requests/sec> to localhost
=item * B<Connection reuse> via keep-alive pooling
=item * B<Minimal memory overhead> with slot-based context management
=back
=head1 AUTHOR
lnation E<lt>email@lnation.orgE<gt>
=head1 LICENSE
lib/Hypersonic/UA/Async.pm view on Meta::CPAN
->line(' SV *future_sv;')
->line(' SV *callback;')
->line(' time_t deadline;')
->line(' char *error;')
->line(' int in_use;')
->line('} AsyncContext;')
->blank
->line('static AsyncContext async_registry[MAX_ASYNC_CONTEXTS];')
->line('static int async_ev_fd = -1;') # event loop fd (kqueue/epoll) for batched polling
->blank
->comment('Async connection pool for keep-alive')
->line('#define ASYNC_POOL_SIZE 512')
->line('typedef struct {')
->line(' int fd;')
->line(' char host[256];')
->line(' int port;')
->line(' time_t expires;')
->line('} AsyncPooledConn;')
->blank
->line('static AsyncPooledConn async_conn_pool[ASYNC_POOL_SIZE];')
->blank
lib/Hypersonic/UA/Async.pm view on Meta::CPAN
->line(' if (async_conn_pool[i].fd > 0 && async_conn_pool[i].port == port &&')
->line(' strcmp(async_conn_pool[i].host, host) == 0 && async_conn_pool[i].expires > now) {')
->line(' int fd = async_conn_pool[i].fd;')
->line(' async_conn_pool[i].fd = 0;')
->line(' return fd;')
->line(' }')
->line(' }')
->line(' return -1;')
->line('}')
->blank
->comment('Return connection to pool (10 second keep-alive)')
->line('static void async_pool_put(int fd, const char *host, int port) {')
->line(' int i;')
->line(' if (fd < 0) return;')
->line(' time_t now = time(NULL);')
->line(' for (i = 0; i < ASYNC_POOL_SIZE; i++) {')
->line(' if (async_conn_pool[i].fd <= 0 || async_conn_pool[i].expires <= now) {')
->line(' if (async_conn_pool[i].fd > 0) close(async_conn_pool[i].fd);')
->line(' async_conn_pool[i].fd = fd;')
->line(' strncpy(async_conn_pool[i].host, host, 255);')
->line(' async_conn_pool[i].host[255] = 0;')
lib/Hypersonic/UA/Async.pm view on Meta::CPAN
->if('SvOK(body_sv)')
->line('body = SvPV(body_sv, body_len);')
->endif
->blank
->line('size_t req_cap = method_len + strlen(path) + host_len + 128 + body_len;')
->line('ctx->request = (char *)malloc(req_cap);')
->blank
->line('int req_len = snprintf(ctx->request, req_cap,')
->line(' "%s %s HTTP/1.1\\r\\n"')
->line(' "Host: %s\\r\\n"')
->line(' "Connection: keep-alive\\r\\n"')
->line(' "User-Agent: Hypersonic/1.0\\r\\n",')
->line(' method, path, ctx->host);')
->blank
->if('body_len > 0')
->line('req_len += snprintf(ctx->request + req_len, req_cap - req_len,')
->line(' "Content-Length: %zu\\r\\n\\r\\n", body_len);')
->line('memcpy(ctx->request + req_len, body, body_len);')
->line('req_len += body_len;')
->else
->line('req_len += snprintf(ctx->request + req_len, req_cap - req_len, "\\r\\n");')
lib/Hypersonic/UA/Pool.pm view on Meta::CPAN
$class->gen_pool_structures($builder, $max_per_host, $max_hosts);
$class->gen_pool_helpers($builder);
$class->gen_xs_init($builder);
$class->gen_xs_get($builder);
$class->gen_xs_put($builder);
$class->gen_xs_remove($builder);
$class->gen_xs_clear($builder);
$class->gen_xs_prune($builder);
$class->gen_xs_stats($builder);
$class->gen_xs_is_alive($builder);
}
sub get_xs_functions {
return {
'Hypersonic::UA::Pool::init' => { source => 'xs_pool_init', is_xs_native => 1 },
'Hypersonic::UA::Pool::get' => { source => 'xs_pool_get', is_xs_native => 1 },
'Hypersonic::UA::Pool::put' => { source => 'xs_pool_put', is_xs_native => 1 },
'Hypersonic::UA::Pool::remove' => { source => 'xs_pool_remove', is_xs_native => 1 },
'Hypersonic::UA::Pool::clear' => { source => 'xs_pool_clear', is_xs_native => 1 },
'Hypersonic::UA::Pool::prune' => { source => 'xs_pool_prune', is_xs_native => 1 },
'Hypersonic::UA::Pool::stats' => { source => 'xs_pool_stats', is_xs_native => 1 },
'Hypersonic::UA::Pool::is_alive' => { source => 'xs_pool_is_alive', is_xs_native => 1 },
};
}
sub gen_pool_structures {
my ($class, $builder, $max_per_host, $max_hosts) = @_;
$builder->line('#include <string.h>')
->line('#include <time.h>')
->line('#include <unistd.h>')
->line('#include <sys/socket.h>')
lib/Hypersonic/UA/Pool.pm view on Meta::CPAN
->line(' b = &g_pool.buckets[g_pool.bucket_count++];')
->line(' memset(b, 0, sizeof(PoolBucket));')
->line(' strncpy(b->host, host, 255);')
->line(' b->host[255] = \'\\0\';')
->line(' b->port = port;')
->line(' b->tls = tls;')
->line(' return b;')
->line('}')
->blank;
# Check if socket is alive
$builder->line('static int pool_check_alive(int fd) {')
->line(' fd_set rfds;')
->line(' FD_ZERO(&rfds);')
->line(' FD_SET(fd, &rfds);')
->blank
->line(' struct timeval tv = {0, 0};')
->line(' int ready = select(fd + 1, &rfds, NULL, NULL, &tv);')
->blank
->line(' if (ready > 0) {')
->line(' char peek;')
->line(' int n = recv(fd, &peek, 1, MSG_PEEK | MSG_DONTWAIT);')
lib/Hypersonic/UA/Pool.pm view on Meta::CPAN
->line(' if (c->fd <= 0 || c->in_use) continue;')
->blank
->line(' int age = now - c->last_used;')
->line(' if (age >= g_pool.idle_timeout) {')
->line(' pool_close_conn(c);')
->line(' b->count--;')
->line(' g_pool.total_count--;')
->line(' continue;')
->line(' }')
->blank
->line(' if (pool_check_alive(c->fd)) {')
->line(' c->in_use = 1;')
->line(' g_pool.hits++;')
->line(' ST(0) = sv_2mortal(newSViv(c->fd));')
->line(' XSRETURN(1);')
->line(' } else {')
->line(' pool_close_conn(c);')
->line(' b->count--;')
->line(' g_pool.total_count--;')
->line(' }')
->line('}')
lib/Hypersonic/UA/Pool.pm view on Meta::CPAN
->line(' hit_rate = (double)g_pool.hits / total_requests;')
->line('}')
->line('hv_stores(stats, "hit_rate", newSVnv(hit_rate));')
->blank
->line('ST(0) = sv_2mortal(newRV_noinc((SV*)stats));')
->xs_return('1')
->xs_end
->blank;
}
sub gen_xs_is_alive {
my ($class, $builder) = @_;
$builder->comment('Check if fd is alive')
->xs_function('xs_pool_is_alive')
->xs_preamble
->line('if (items != 1) croak("Usage: is_alive(fd)");')
->blank
->line('int fd = SvIV(ST(0));')
->line('int alive = pool_check_alive(fd);')
->blank
->line('ST(0) = alive ? &PL_sv_yes : &PL_sv_no;')
->xs_return('1')
->xs_end
->blank;
}
1;
__END__
=head1 NAME
lib/Hypersonic/UA/Pool.pm view on Meta::CPAN
my $fd = Hypersonic::UA::Pool::get($host, $port, $tls);
# Return connection to pool
Hypersonic::UA::Pool::put($host, $port, $tls, $fd);
# Get pool statistics
my $stats = Hypersonic::UA::Pool::stats();
=head1 DESCRIPTION
C<Hypersonic::UA::Pool> manages HTTP keep-alive connection pooling for
C<Hypersonic::UA>. It maintains a pool of open TCP connections organized by
host:port:tls, enabling connection reuse for improved performance.
=head1 FUNCTIONS
=head2 init
Hypersonic::UA::Pool::init($max_per_host, $max_total, $idle_timeout);
Initialize the connection pool. Defaults:
lib/Hypersonic/UA/Pool.pm view on Meta::CPAN
total_connections => 42,
hosts_tracked => 5,
max_per_host => 6,
max_total => 100,
idle_timeout => 60,
hits => 1234,
misses => 56,
hit_rate => 0.956,
}
=head2 is_alive
my $alive = Hypersonic::UA::Pool::is_alive($fd);
Check if a socket is still alive (not closed by peer).
=head1 AUTHOR
lnation E<lt>email@lnation.orgE<gt>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
t/0001-dispatch.t view on Meta::CPAN
$server->post('/api/data' => sub { '{"status":"received"}' });
$server->get('/api/users' => sub { '[{"id":1},{"id":2}]' });
$server->put('/api/update' => sub { '{"updated":true}' });
$server->del('/api/delete' => sub { '{"deleted":true}' });
# Compile routes
$server->compile();
ok($server->{compiled}, 'Server compiled');
# Test dispatch with mock requests
# Request format: [method, path, body, keep_alive, fd]
# Note: dispatch now returns FULL HTTP response (headers + body)
my $tests = [
{
name => 'GET /api/hello returns JSON',
request => ['GET', '/api/hello', '', 1, 0],
contains => '{"message":"Hello"}',
header => 'application/json',
},
{
t/0001-dispatch.t view on Meta::CPAN
if ($test->{header}) {
like($response, qr/Content-Type: \Q$test->{header}\E/, "$test->{name} - content type");
}
}
}
# Test HTTP response structure
my $resp = $server->dispatch(['GET', '/api/hello', '', 1, 0]);
like($resp, qr/^HTTP\/1\.1 200 OK\r\n/, 'Response starts with HTTP status');
like($resp, qr/Content-Length: \d+\r\n/, 'Has Content-Length header');
like($resp, qr/Connection: keep-alive\r\n/, 'Has Connection header');
like($resp, qr/\r\n\r\n/, 'Has header/body separator');
# Cleanup
system("rm -rf _test_cache");
done_testing();
t/0003-server.t view on Meta::CPAN
$resp = http_request('GET', '/unknown');
ok($resp, 'Got response for unknown route');
like($resp, qr/HTTP\/1\.1 404/, '404 for unknown route');
like($resp, qr/Not Found/, '404 body');
# Test 5: 404 for wrong method
$resp = http_request('DELETE', '/test');
ok($resp, 'Got response for wrong method');
like($resp, qr/HTTP\/1\.1 404/, '404 for wrong method');
# Test 6: Multiple requests (keep-alive simulation)
for my $i (1..5) {
$resp = http_request('GET', '/test');
ok($resp, "Request $i successful");
like($resp, qr/200 OK/, "Request $i returns 200");
}
# Cleanup
kill('TERM', $pid);
waitpid($pid, 0);
t/0009-security.t view on Meta::CPAN
plan tests => 20;
# Test security hardening configuration options
# Test 1: Default security options
{
my $server = Hypersonic->new(cache_dir => '_test_cache_sec1');
is($server->{max_connections}, 10000, 'Default max_connections is 10000');
is($server->{max_request_size}, 8192, 'Default max_request_size is 8192');
is($server->{keepalive_timeout}, 30, 'Default keepalive_timeout is 30');
is($server->{recv_timeout}, 30, 'Default recv_timeout is 30');
is($server->{drain_timeout}, 5, 'Default drain_timeout is 5');
}
# Test 2: Custom security options
{
my $server = Hypersonic->new(
cache_dir => '_test_cache_sec2',
max_connections => 5000,
max_request_size => 16384,
keepalive_timeout => 60,
recv_timeout => 15,
drain_timeout => 10,
);
is($server->{max_connections}, 5000, 'Custom max_connections');
is($server->{max_request_size}, 16384, 'Custom max_request_size');
is($server->{keepalive_timeout}, 60, 'Custom keepalive_timeout');
}
# Test 3: Security headers - defaults
{
my $server = Hypersonic->new(cache_dir => '_test_cache_sec3');
ok($server->{enable_security_headers}, 'Security headers enabled by default');
is($server->{security_headers}{'X-Frame-Options'}, 'DENY', 'Default X-Frame-Options is DENY');
is($server->{security_headers}{'X-Content-Type-Options'}, 'nosniff', 'Default X-Content-Type-Options is nosniff');
is($server->{security_headers}{'X-XSS-Protection'}, '1; mode=block', 'Default X-XSS-Protection');
t/0027-chunked-encoding.t view on Meta::CPAN
require XS::JIT::Builder;
my $builder = XS::JIT::Builder->new;
Hypersonic::Protocol::HTTP1->gen_chunked_start($builder);
my $code = $builder->code;
like($code, qr/void send_chunked_headers\(/, 'function defined');
like($code, qr/Transfer-Encoding: chunked/, 'chunked header included');
like($code, qr/Content-Type: %s/, 'content-type placeholder');
like($code, qr/Connection: keep-alive/, 'keep-alive for streaming');
like($code, qr/send\(fd, headers/, 'sends headers');
};
subtest 'gen_chunked_write uses writev' => sub {
plan tests => 4;
require XS::JIT::Builder;
my $builder = XS::JIT::Builder->new;
Hypersonic::Protocol::HTTP1->gen_chunked_write($builder);
t/0029-sse.t view on Meta::CPAN
);
like($event, qr/data: line1\n/, 'first line');
like($event, qr/data: line2\n/, 'second line');
like($event, qr/data: line3\n/, 'third line');
};
subtest 'format helpers' => sub {
plan tests => 3;
my $keepalive = Hypersonic::Protocol::SSE->format_keepalive();
like($keepalive, qr/^: keepalive\n\n$/, 'keepalive format');
my $retry = Hypersonic::Protocol::SSE->format_retry(3000);
like($retry, qr/^retry: 3000\n\n$/, 'retry format');
my $comment = Hypersonic::Protocol::SSE->format_comment('test');
like($comment, qr/^: test\n\n$/, 'comment format');
};
# ============================================================
# Test 8-11: Protocol::SSE C code generation
t/0029-sse.t view on Meta::CPAN
Hypersonic::Protocol::SSE->gen_event_formatter($builder);
my $code = $builder->code;
like($code, qr/format_sse_event/, 'function defined');
like($code, qr/event: %s/, 'event type format');
like($code, qr/data: /, 'data format');
like($code, qr/id: %s/, 'id format');
like($code, qr/while \(\*p\)/, 'multiline loop');
};
subtest 'gen_keepalive C code' => sub {
plan tests => 2;
require XS::JIT::Builder;
my $builder = XS::JIT::Builder->new;
Hypersonic::Protocol::SSE->gen_keepalive($builder);
my $code = $builder->code;
like($code, qr/format_sse_keepalive/, 'function defined');
like($code, qr/: keepalive/, 'keepalive comment');
};
subtest 'gen_retry C code' => sub {
plan tests => 2;
require XS::JIT::Builder;
my $builder = XS::JIT::Builder->new;
Hypersonic::Protocol::SSE->gen_retry($builder);
my $code = $builder->code;
t/0029-sse.t view on Meta::CPAN
subtest 'generate_c_code C code' => sub {
plan tests => 4;
require XS::JIT::Builder;
my $builder = XS::JIT::Builder->new;
Hypersonic::Protocol::SSE->generate_c_code($builder);
my $code = $builder->code;
like($code, qr/format_sse_event/, 'has event formatter');
like($code, qr/format_sse_keepalive/, 'has keepalive');
like($code, qr/format_sse_retry/, 'has retry');
like($code, qr/format_sse_comment/, 'has comment');
};
# ============================================================
# Test 12-15: Hypersonic::SSE wrapper
# ============================================================
subtest 'SSE object creation' => sub {
plan tests => 4;
t/0029-sse.t view on Meta::CPAN
plan tests => 1;
my $mock_stream = MockStream2->new;
my $sse = Hypersonic::SSE->new($mock_stream);
$sse->data('simple message');
like($mock_stream->{writes}[0], qr/data: simple message/, 'data was written');
};
subtest 'SSE keepalive' => sub {
plan tests => 1;
my $mock_stream = MockStream3->new;
my $sse = Hypersonic::SSE->new($mock_stream);
$sse->keepalive();
like($mock_stream->{writes}[0], qr/^: keepalive\n\n$/, 'keepalive sent');
};
# ============================================================
# Test 16-17: SSE content type
# ============================================================
subtest 'SSE content type' => sub {
plan tests => 1;
is(Hypersonic::Protocol::SSE->content_type, 'text/event-stream', 'correct MIME type');
};
t/0029-sse.t view on Meta::CPAN
subtest 'Event data-only (no type)' => sub {
plan tests => 2;
my $event = Hypersonic::Protocol::SSE->format_event(data => 'test');
unlike($event, qr/event:/, 'no event line when type not specified');
like($event, qr/data: test\n/, 'has data');
};
subtest 'needs_keepalive timing' => sub {
plan tests => 2;
my $mock_stream = MockStream5->new;
# Use a very short keepalive interval (1 second)
my $sse = Hypersonic::SSE->new($mock_stream, keepalive => 1);
ok(!$sse->needs_keepalive, 'no keepalive needed immediately');
# Wait for the keepalive interval to elapse
sleep(2);
ok($sse->needs_keepalive, 'keepalive needed after interval');
};
done_testing();
t/0035-e2e-streaming.t view on Meta::CPAN
my $sse = Hypersonic::SSE->new($stream);
$sse->event(type => 'greeting', data => 'Hello SSE!');
$sse->event(type => 'update', data => 'First update', id => '1');
$sse->event(type => 'update', data => "Multi\nLine\nData", id => '2');
$sse->data('simple data');
$sse->comment('test comment');
$sse->retry(5000);
$sse->close();
}, { streaming => 1 });
# SSE with keepalive test
$server->get('/sse-keepalive' => sub {
my ($req, $stream) = @_;
require Hypersonic::SSE;
my $sse = Hypersonic::SSE->new($stream, keepalive => 1);
$sse->event(data => 'start');
$sse->keepalive();
$sse->event(data => 'end');
$sse->close();
}, { streaming => 1 });
# WebSocket echo route
$server->websocket('/ws-echo' => sub {
my ($ws) = @_;
$ws->on(message => sub {
my ($data) = @_;
$ws->send("echo: $data");
t/0035-e2e-streaming.t view on Meta::CPAN
like($resp, qr/data: Multi\n.*data: Line\n.*data: Data\n/s, 'Multiline data formatted correctly');
# Comment
like($resp, qr/: test comment\n/, 'Comment formatted correctly');
# Retry
like($resp, qr/retry: 5000\n/, 'Retry directive present');
};
# ============================================================
# Test 4: SSE keepalive
# ============================================================
subtest 'SSE keepalive' => sub {
plan tests => 3;
my $resp = http_request('GET', '/sse-keepalive');
ok($resp, 'Got SSE response with keepalive');
like($resp, qr/: keepalive\n/, 'Keepalive comment present');
like($resp, qr/data: start\n.*: keepalive\n.*data: end\n/s, 'Keepalive in correct position');
};
# ============================================================
# Test 5: WebSocket handshake
# ============================================================
subtest 'WebSocket handshake' => sub {
plan tests => 5;
my $ws = ws_connect('/ws-echo');
ok($ws, 'WebSocket connection initiated');
t/2006-ua-pool.t view on Meta::CPAN
ok($funcs, 'get_xs_functions returns hashref');
my @expected = qw(
Hypersonic::UA::Pool::init
Hypersonic::UA::Pool::get
Hypersonic::UA::Pool::put
Hypersonic::UA::Pool::remove
Hypersonic::UA::Pool::clear
Hypersonic::UA::Pool::prune
Hypersonic::UA::Pool::stats
Hypersonic::UA::Pool::is_alive
);
for my $func (@expected) {
ok(exists $funcs->{$func}, "Function $func registered");
ok($funcs->{$func}{source}, "Function $func has source");
ok($funcs->{$func}{is_xs_native}, "Function $func is XS native");
}
};
subtest 'C code generation' => sub {
t/2006-ua-pool.t view on Meta::CPAN
} 'generate_c_code runs without error';
my $code = $builder->code;
like($code, qr/PoolConn/, 'Contains PoolConn struct');
like($code, qr/PoolBucket/, 'Contains PoolBucket struct');
like($code, qr/ConnectionPool/, 'Contains ConnectionPool struct');
like($code, qr/g_pool/, 'Contains global pool');
like($code, qr/pool_find_bucket/, 'Contains find_bucket helper');
like($code, qr/pool_get_bucket/, 'Contains get_bucket helper');
like($code, qr/pool_check_alive/, 'Contains check_alive helper');
like($code, qr/pool_close_conn/, 'Contains close_conn helper');
like($code, qr/xs_pool_init/, 'Contains init XS function');
like($code, qr/xs_pool_get/, 'Contains get XS function');
like($code, qr/xs_pool_put/, 'Contains put XS function');
like($code, qr/xs_pool_stats/, 'Contains stats XS function');
like($code, qr/hit_rate/, 'Stats include hit_rate');
};
done_testing;
t/2102-ua-keepalive.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
use POSIX ":sys_wait_h";
use IO::Socket::INET;
use Time::HiRes qw(time);
# Connection pooling and keep-alive tests
# Helper to get status/body from response (hash or object)
sub res_status { my $r = shift; ref($r) eq 'HASH' ? $r->{status} : $r->status }
sub res_body { my $r = shift; ref($r) eq 'HASH' ? $r->{body} : $r->body }
my $PORT = 33000 + ($$ % 1000);
my $server_pid;
sub start_test_server {
$server_pid = fork();
die "Fork failed" unless defined $server_pid;
if ($server_pid == 0) {
require Hypersonic;
my $server = Hypersonic->new(cache_dir => "_test_keepalive_server_$$");
$server->get('/ping' => sub { 'pong' });
# Return connection info - must be dynamic to access $req
$server->get('/conninfo' => sub {
my ($req) = @_;
my $conn = $req->header('Connection') // 'none';
return qq({"connection":"$conn"});
}, { dynamic => 1 });
t/2102-ua-keepalive.t view on Meta::CPAN
select(undef, undef, undef, 0.1);
}
die "Server failed to start";
}
sub stop_test_server {
if ($server_pid) {
kill('TERM', $server_pid);
waitpid($server_pid, 0);
}
system("rm -rf _test_keepalive_server_*");
}
END { stop_test_server() }
start_test_server();
pass('Test server started');
use_ok('Hypersonic::UA');
# Compile with minimal features (blocking only - no async needed for keepalive test)
eval { Hypersonic::UA->compile(cache_dir => "_test_keepalive_client_$$") };
ok(!$@, 'UA compiled successfully') or diag $@;
my $ua = Hypersonic::UA->new();
ok($ua, 'Created UA instance');
subtest 'Multiple sequential requests reuse connections' => sub {
# Make several requests - connection pooling should kick in
my $start = time();
for my $i (1..10) {
my $res = $ua->get("http://127.0.0.1:$PORT/ping");
is(res_status($res), 200, "Request $i succeeded");
is(res_body($res), 'pong', "Request $i body correct");
}
my $elapsed = time() - $start;
# With connection reuse, 10 requests should be fast
ok($elapsed < 2, "10 requests completed in ${elapsed}s (should reuse connections)");
};
subtest 'Keep-alive header sent' => sub {
my $res = $ua->get("http://127.0.0.1:$PORT/conninfo");
is(res_status($res), 200, 'Got response');
# Check if keep-alive or close
my $body = res_body($res);
ok($body =~ /\"connection\"/, 'Response has connection info');
};
subtest 'Rapid fire requests' => sub {
my @responses;
my $start = time();
for (1..20) {
push @responses, $ua->get("http://127.0.0.1:$PORT/ping");
}
my $elapsed = time() - $start;
my $success_count = grep { res_status($_) == 200 } @responses;
is($success_count, 20, 'All 20 requests succeeded');
note("20 sequential requests in ${elapsed}s");
};
# Cleanup
system("rm -rf _test_keepalive_client_*");
done_testing();
( run in 2.913 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )