PAGI-Tools
view release on metacpan or search on metacpan
lib/PAGI/Response.pm view on Meta::CPAN
Can be a specific origin like C<'https://example.com'> or C<'*'> for any.
=item * C<methods> - Arrayref of allowed HTTP methods for preflight.
Default: C<[qw(GET POST PUT DELETE PATCH OPTIONS)]>.
=item * C<headers> - Arrayref of allowed request headers for preflight.
Default: C<[qw(Content-Type Authorization X-Requested-With)]>.
=item * C<expose> - Arrayref of response headers to expose to the client.
By default, only simple headers (Cache-Control, Content-Language, etc.)
are accessible. Use this to expose custom headers.
=item * C<credentials> - Boolean. If true, sets
C<Access-Control-Allow-Credentials: true>, allowing cookies and
Authorization headers. Default: C<0>.
=item * C<max_age> - How long (in seconds) browsers should cache preflight
results. Default: C<86400> (24 hours).
=item * C<preflight> - Boolean. If true, includes preflight response headers
(Allow-Methods, Allow-Headers, Max-Age). Set this when handling OPTIONS
requests. Default: C<0>.
=item * C<request_origin> - The Origin header value from the request.
Required when C<credentials> is true and C<origin> is C<'*'>, because
the CORS spec forbids using C<'*'> with credentials. Pass the actual
request origin to echo it back.
=back
B<Important CORS Notes:>
=over 4
=item * When C<credentials> is true, you cannot use C<< origin => '*' >>.
Either specify an exact origin, or pass C<request_origin> with the
client's actual Origin header.
=item * The C<Vary: Origin> header is always set to ensure proper caching
when origin-specific responses are used.
=item * For preflight (OPTIONS) requests, set C<< preflight => 1 >> and
typically respond with C<< $res->status(204)->empty() >>.
=back
=head1 SEND PRIMITIVE AND APP MOUNTING
=head2 respond
await $res->respond($send);
The single send primitive for a detached response value. Reads the
accumulated status, headers, and body from C<$self> and emits the
appropriate PAGI protocol events via C<$send>.
C<$send> must be a coderef (the PAGI send callback). C<respond> does
B<not> mutate the response object, so the same response value can be
passed to C<respond> multiple times for different connections.
For streaming responses (set up via the C<_stream> slot), C<respond>
sends the start event, runs the stream callback with a
L<PAGI::Response::Writer>, and ensures the writer is closed.
Returns a L<Future>.
=head2 to_app
my $app = $res->to_app;
Returns a PAGI application coderef C<sub ($scope, $receive, $send)> that
calls L</respond> with the given C<$send> when invoked. Use this to mount
a response value directly as a PAGI app:
my $not_found = PAGI::Response->new
->status(404)
->_set_body('Not Found', 'text/plain');
# Mount as a fallback app
my $app = $not_found->to_app;
=head1 BODY METHODS
These methods set the response body and return C<$self>. Sending happens via
L</respond> / L</to_app> or the endpoint return contract.
Each method works as both a B<class-method factory> and an B<instance method>:
# Class-method factory — creates a new detached response and returns it
return $ctx->json($data); # instance method on existing $res
return PAGI::Response->json($data); # factory shorthand
# Chain body with other setters before sending
PAGI::Response->json($data)->status(201)->respond($send)->get;
The Content-Type these methods set is a B<default>: an explicit C<content_type>
set beforehand is preserved, not overridden.
These helpers UTF-8-encode the body, so they make the Content-Type advertise
that encoding. When you preset a charset-less type they append C<; charset=utf-8>
to it — C<< content_type('application/xml')->html($xml) >> sends
C<application/xml; charset=utf-8> (charset is meaningful for XML and C<text/*>,
RFC 7303). The exceptions are C<application/json> and the C<+json> structured-suffix
types, which are left bare: JSON is always UTF-8 and defines no charset parameter
(RFC 8259). An explicit charset you set yourself is never overridden. If you need
a body in some other encoding, encode it yourself and use L</send_raw>.
=head2 Trailing options (status, content_type, headers)
The body methods C<text>, C<html>, C<json>, C<send_raw>, and C<empty> accept
trailing named options as a convenience so you can set status, content-type,
and extra headers in a single call without chaining:
PAGI::Response->json($data, status => 404);
PAGI::Response->text('Hi', status => 201, headers => ['X-Foo' => 'bar']);
PAGI::Response->send_raw($bytes, content_type => 'application/octet-stream');
PAGI::Response->empty(status => 304);
Recognised options:
=over 4
lib/PAGI/Response.pm view on Meta::CPAN
PAGI::Response->json({ message => 'Hello' });
PAGI::Response->json({ error => 'nope' }, status => 404);
Set body to the JSON-encoded data with Content-Type: application/json. No charset
parameter is added — JSON is always UTF-8 and C<application/json> defines none
(RFC 8259). Accepts trailing options (C<status>, C<content_type>, C<headers>).
Returns C<$self>.
=head2 redirect
$res->redirect('/login');
$res->redirect('/new-url', 301);
PAGI::Response->redirect('/login');
Set an empty body and a Location header. Default status is 302. Returns C<$self>.
B<Why no body?> While RFC 7231 suggests including a short HTML body with a
hyperlink for clients that don't auto-follow redirects, all modern browsers
and HTTP clients ignore redirect bodies. If you need a body for legacy
compatibility, set it explicitly after calling C<redirect>.
=head2 empty
$res->empty;
PAGI::Response->new->empty;
PAGI::Response->empty(status => 304);
Set an empty body with status 204 No Content (or keep a previously set status).
Accepts trailing options (C<status>, C<content_type>, C<headers>); an explicit
C<status> option overrides the 204 default. Returns C<$self>.
=head2 send
$res->send($text);
$res->send($text, charset => 'iso-8859-1');
Set body to the encoded text (UTF-8 by default, or the specified charset).
Defaults the Content-Type to C<text/plain> and appends the charset to a
charset-less type, on the same rules as L</text> (C<application/json> and
C<+json> types stay bare). Returns C<$self>.
=head2 send_raw
$res->send_raw($bytes);
PAGI::Response->send_raw($bytes, content_type => 'application/octet-stream');
Set body to raw bytes without any encoding. Use for binary data or pre-encoded
content. Accepts trailing options (C<status>, C<content_type>, C<headers>).
Returns C<$self>.
=head2 stream
$res->stream(async sub {
my ($writer) = @_;
await $writer->write("chunk1");
await $writer->write("chunk2");
await $writer->close();
});
PAGI::Response->stream($callback);
Store a streaming callback. When the response is sent via L</respond>, the callback
receives a L<PAGI::Response::Writer> and streams chunks. Returns C<$self>.
=head2 writer
my $writer = await $res->writer($send);
my $writer = await $res->writer($send, on_close => sub { cleanup() });
my $writer = await $res->writer($send, on_close => async sub { await cleanup() });
Returns a L<PAGI::Response::Writer> directly, sending headers immediately.
Unlike C<stream()>, the writer is not scoped to a callback — you own it
and must call C<close()> when done.
C<$send> must be a coderef (the PAGI send callback). This is the same
C<$send> you would pass to L</respond>.
This is useful when the writer needs to be passed to event handlers,
pub/sub callbacks, timers, or other contexts outside a single function:
async sub live_feed {
my ($self, $ctx) = @_;
my $writer = await $ctx->response
->content_type('text/plain')
->writer($ctx->send, on_close => sub { $bus->unsubscribe($id) });
my $id = $bus->subscribe(async sub ($line) {
await $writer->write("$line\n");
});
await $ctx->receive; # wait for disconnect
await $writer->close;
}
The optional C<on_close> callback is registered before headers are sent,
eliminating any race window with fast client disconnects. Sync and async
callbacks are both supported — see L</on_close> under L</WRITER OBJECT>.
=head2 send_file
$res->send_file('/path/to/file.pdf');
$res->send_file('/path/to/file.pdf',
filename => 'download.pdf',
inline => 1,
);
PAGI::Response->send_file('/path/to/file.pdf');
# Partial file (for range requests)
$res->send_file('/path/to/video.mp4',
offset => 1024, # Start from byte 1024
length => 65536, # Send 64KB
);
Set the response to serve a file. Stats the file and sets Content-Type,
Content-Length, and Content-Disposition at call time. The PAGI protocol's
C<file> key is used for efficient server-side streaming (file not read into
memory) when L</respond> is called. Returns C<$self>.
For production, use L<PAGI::Middleware::XSendfile> to delegate file serving
to your reverse proxy.
B<Options:>
=over 4
=item * C<filename> - Set Content-Disposition attachment filename
=item * C<inline> - Use Content-Disposition: inline instead of attachment
=item * C<offset> - Start position in bytes (default: 0). For range requests.
=item * C<length> - Number of bytes to send. Defaults to file size minus offset.
=back
B<Range Request Example:>
# Manual range request handling
async sub handle_video {
my ($req, $send) = @_;
my $path = '/videos/movie.mp4';
my $size = -s $path;
my $range = $req->header('Range');
if ($range && $range =~ /bytes=(\d+)-(\d*)/) {
my $start = $1;
my $end = $2 || ($size - 1);
my $length = $end - $start + 1;
return await PAGI::Response->new
->status(206)
->header('Content-Range' => "bytes $start-$end/$size")
->header('Accept-Ranges' => 'bytes')
->send_file($path, offset => $start, length => $length)
->respond($send);
}
return await PAGI::Response->new
->header('Accept-Ranges' => 'bytes')
->send_file($path)
->respond($send);
}
B<Note:> For production file serving with full features (ETag caching,
automatic range request handling, conditional GETs, directory indexes),
use L<PAGI::App::File> instead:
use PAGI::App::File;
my $files = PAGI::App::File->new(root => '/var/www/static');
my $app = $files->to_app;
=head1 EXAMPLES
=head2 Complete Raw PAGI Application
use Future::AsyncAwait;
lib/PAGI/Response.pm view on Meta::CPAN
sub delete_cookie {
my ($self, $name, %opts) = @_;
return $self->cookie($name, '',
max_age => 0,
path => $opts{path},
domain => $opts{domain},
);
}
sub cors {
my ($self, %opts) = @_;
my $origin = $opts{origin} // '*';
my $credentials = $opts{credentials} // 0;
my $methods = $opts{methods} // [qw(GET POST PUT DELETE PATCH OPTIONS)];
my $headers = $opts{headers} // [qw(Content-Type Authorization X-Requested-With)];
my $expose = $opts{expose} // [];
my $max_age = $opts{max_age} // 86400;
my $preflight = $opts{preflight} // 0;
# Determine the origin to send back
my $allow_origin;
if ($origin eq '*' && $credentials) {
# With credentials, can't use wildcard - use request_origin if provided
$allow_origin = $opts{request_origin} // '*';
} else {
$allow_origin = $origin;
}
# Core CORS headers (always set)
$self->header('Access-Control-Allow-Origin', $allow_origin);
$self->header('Vary', 'Origin');
if ($credentials) {
$self->header('Access-Control-Allow-Credentials', 'true');
}
if (@$expose) {
$self->header('Access-Control-Expose-Headers', join(', ', @$expose));
}
# Preflight headers (for OPTIONS responses or when explicitly requested)
if ($preflight) {
$self->header('Access-Control-Allow-Methods', join(', ', @$methods));
$self->header('Access-Control-Allow-Headers', join(', ', @$headers));
$self->header('Access-Control-Max-Age', $max_age);
}
return $self;
}
sub stream {
my ($proto, $callback) = @_;
my $self = $proto->_self_or_new;
$self->{_stream} = $callback;
return $self;
}
async sub writer {
my ($self, $send, %opts) = @_;
croak("send must be a coderef") unless ref($send) eq 'CODE';
# A writer takes over the connection for live streaming; it can only be
# taken once on a given response value. (The cross-stack "did a response
# start" fact lives on pagi.connection; this is a local single-takeover guard.)
croak("Response already sent") if $self->{_writer_started};
$self->{_writer_started} = 1;
# Send headers
await $send->({
type => 'http.response.start',
status => $self->status,
headers => $self->_render_headers(undef),
});
return PAGI::Response::Writer->new($send, %opts);
}
# Simple MIME type mapping
my %MIME_TYPES = (
'.html' => 'text/html',
'.htm' => 'text/html',
'.txt' => 'text/plain',
'.css' => 'text/css',
'.js' => 'application/javascript',
'.json' => 'application/json',
'.xml' => 'application/xml',
'.pdf' => 'application/pdf',
'.zip' => 'application/zip',
'.png' => 'image/png',
'.jpg' => 'image/jpeg',
'.jpeg' => 'image/jpeg',
'.gif' => 'image/gif',
'.svg' => 'image/svg+xml',
'.ico' => 'image/x-icon',
'.woff' => 'font/woff',
'.woff2'=> 'font/woff2',
);
sub _mime_type {
my ($path) = @_;
my ($ext) = $path =~ /(\.[^.]+)$/;
return $MIME_TYPES{lc($ext // '')} // 'application/octet-stream';
}
sub send_file {
my ($proto, $path, %opts) = @_;
my $self = $proto->_self_or_new;
croak("File not found: $path") unless -f $path;
croak("Cannot read file: $path") unless -r $path;
# Get file size
my $file_size = -s $path;
# Handle offset and length for range requests
my $offset = $opts{offset} // 0;
my $length = $opts{length};
# Validate offset
croak("offset must be non-negative") if $offset < 0;
croak("offset exceeds file size") if $offset > $file_size;
# Calculate actual length to send
my $max_length = $file_size - $offset;
if (defined $length) {
croak("length must be non-negative") if $length < 0;
$length = $max_length if $length > $max_length;
} else {
$length = $max_length;
}
# Set content-type if not already set
$self->content_type_try(_mime_type($path));
# Set content-length based on actual bytes to send
$self->header('content-length', $length);
# Set content-disposition
my $disposition;
if ($opts{inline}) {
$disposition = 'inline';
} elsif ($opts{filename}) {
# Sanitize filename for header
my $safe_filename = $opts{filename};
$safe_filename =~ s/["\r\n]//g;
$disposition = "attachment; filename=\"$safe_filename\"";
}
$self->header('content-disposition', $disposition) if $disposition;
# Store the file send descriptor; respond() handles the actual emission.
# offset/length are stored only when they narrow the full-file default.
my $file_desc = { path => $path };
$file_desc->{offset} = $offset if $offset > 0;
$file_desc->{length} = $length if $length < $max_length;
$self->{_file} = $file_desc;
return $self;
}
# Writer class for streaming responses
package PAGI::Response::Writer {
use strict;
use warnings;
use Future::AsyncAwait;
use Carp qw(croak);
use Scalar::Util qw(blessed);
sub new {
my ($class, $send, %opts) = @_;
my $self = bless {
send => $send,
bytes_written => 0,
closed => 0,
_on_close => [],
}, $class;
push @{$self->{_on_close}}, $opts{on_close} if $opts{on_close};
return $self;
}
async sub write {
my ($self, $chunk) = @_;
die 'Writer already closed' if $self->{closed};
$self->{bytes_written} += length($chunk // '');
await $self->{send}->({
type => 'http.response.body',
body => $chunk,
more => 1,
});
}
async sub close {
my ($self) = @_;
return if $self->{closed};
$self->{closed} = 1;
await $self->{send}->({
type => 'http.response.body',
body => '',
more => 0,
});
for my $cb (@{$self->{_on_close}}) {
eval {
my $r = $cb->();
if (blessed($r) && $r->isa('Future')) {
await $r;
}
};
if ($@) {
warn "PAGI::Response::Writer on_close callback error: $@";
}
}
# Clear callback array to break any closure-based cycles
$self->{_on_close} = [];
}
sub on_close {
my ($self, $cb) = @_;
push @{$self->{_on_close}}, $cb;
return $self;
}
( run in 0.843 second using v1.01-cache-2.11-cpan-6aa56a78535 )