PAGI-Tools
view release on metacpan or search on metacpan
lib/PAGI/Request.pm view on Meta::CPAN
my $auth = $self->header('authorization') // '';
if ($auth =~ /^Basic\s+(.+)$/i) {
my $decoded = decode_base64($1);
my ($user, $pass) = split /:/, $decoded, 2;
return ($user, $pass);
}
return (undef, undef);
}
# Path parameters - captured from URL path by router
# Stored in scope->{path_params} for router-agnostic access
sub path_params {
my ($self, %opts) = @_;
my $strict = delete $opts{strict};
croak("Unknown options to path_params: " . join(', ', keys %opts)) if %opts;
my $params = $self->{scope}{path_params};
if (!defined $params && $strict) {
croak "path_params not set in scope (no router configured?). "
. "Pass strict => 0 to allow this.";
}
return $params // {};
}
sub _default_path_param_strict_opt { return 1 }
sub path_param {
my ($self, $name, %opts) = @_;
my $strict = exists $opts{strict} ? delete $opts{strict} : $self->_default_path_param_strict_opt;
croak("Unknown options to path_param: " . join(', ', keys %opts)) if %opts;
my $params = $self->path_params;
if ($strict && !exists $params->{$name}) {
my @available = keys %$params;
croak "path_param '$name' not found. "
. (@available ? "Available: " . join(', ', sort @available) : "No path params set (no router?)");
}
return $params->{$name};
}
sub scope { shift->{scope} }
# Vend a detached response bound to this request's scope (the raw-app analog
# of $ctx->response). It is a value, not a connection; call ->respond($send)
# to send it.
sub response {
my $self = shift;
require PAGI::Response;
return PAGI::Response->new($self->{scope});
}
# Application state (injected by PAGI::Lifespan, read-only)
sub state {
my $self = shift;
return $self->{scope}{state} // {};
}
# Body streaming - mutually exclusive with buffered body methods
sub body_stream {
my ($self, %opts) = @_;
croak "Body already consumed; streaming not available" if $self->{scope}{'pagi.request.body.read'};
croak "Body streaming already started" if $self->{scope}{'pagi.request.body.stream.created'};
$self->{scope}{'pagi.request.body.stream.created'} = 1;
my $max_bytes = $opts{max_bytes};
my $limit_name = defined $max_bytes ? 'max_bytes' : undef;
if (!defined $max_bytes) {
my $cl = $self->content_length;
if (defined $cl) {
$max_bytes = $cl;
$limit_name = 'content-length';
}
}
return PAGI::Request::BodyStream->new(
receive => $self->{receive},
max_bytes => $max_bytes,
limit_name => $limit_name,
decode => $opts{decode},
strict => $opts{strict},
);
}
# Streaming multipart - mutually exclusive with buffered body methods
sub multipart_stream {
my ($self, %opts) = @_;
croak "Body already consumed; multipart_stream() not available"
if $self->{scope}{'pagi.request.body.read'}
|| $self->{scope}{'pagi.request.body.stream.created'};
croak "multipart_stream() requires a multipart/form-data request" unless $self->is_multipart;
my $ct = $self->header('content-type') // '';
my ($boundary) = $ct =~ /boundary=([^;\s]+)/;
$boundary =~ s/^["']|["']$//g if defined $boundary; # Strip quotes
croak "No boundary found in Content-Type" unless defined $boundary && length $boundary;
$self->{scope}{'pagi.request.body.stream.created'} = 1; # latch: lock out buffered readers
require PAGI::Request::MultipartStream;
return PAGI::Request::MultipartStream->new(
receive => $self->{receive},
boundary => $boundary,
map { defined $opts{$_} ? ($_ => $opts{$_}) : () }
qw(max_files max_fields max_field_size max_file_size max_request_body),
);
}
# Read raw body bytes (async, cached in scope)
async sub body {
my $self = shift;
croak "Body streaming already started; buffered helpers unavailable"
if $self->{scope}{'pagi.request.body.stream.created'};
# Return cached body if already read
return $self->{scope}{'pagi.request.body'} if $self->{scope}{'pagi.request.body.read'};
my $receive = $self->{receive};
die "No receive callback provided" unless $receive;
my $body = '';
while (1) {
my $message = await $receive->();
last unless $message && $message->{type};
last if $message->{type} eq 'http.disconnect';
$body .= $message->{body} // '';
last unless $message->{more};
}
$self->{scope}{'pagi.request.body'} = $body;
$self->{scope}{'pagi.request.body.read'} = 1;
return $body;
}
# Read body as decoded UTF-8 text (async)
# Options: strict => 1 (croak on invalid UTF-8)
async sub text {
my ($self, %opts) = @_;
my $strict = delete $opts{strict} // 0;
croak("Unknown options to text: " . join(', ', keys %opts)) if %opts;
my $body = await $self->body;
return _decode_utf8($body, $strict);
}
# Parse body as JSON (async, dies on error)
async sub json {
my $self = shift;
my $body = await $self->body;
return decode_json($body);
}
# Parse URL-encoded form body (async, returns Hash::MultiValue, cached in scope)
# Options: strict => 1 (croak on invalid UTF-8), raw => 1 (skip UTF-8 decoding)
async sub form_params {
my ($self, %opts) = @_;
my $strict = delete $opts{strict} // 0;
my $raw = delete $opts{raw} // 0;
# Extract multipart options before checking for unknown opts
my %multipart_opts;
for my $key (qw(max_field_size max_file_size spool_threshold max_files max_fields temp_dir)) {
$multipart_opts{$key} = delete $opts{$key} if exists $opts{$key};
}
croak("Unknown options to form_params: " . join(', ', keys %opts)) if %opts;
my $cache_key = $raw ? 'pagi.request.form.raw' : ($strict ? 'pagi.request.form.strict' : 'pagi.request.form');
# Return cached if available
return $self->{scope}{$cache_key} if $self->{scope}{$cache_key};
lib/PAGI/Request.pm view on Meta::CPAN
my @pairs;
for my $part (split /[&;]/, $body) {
next unless length $part;
my ($key, $val) = split /=/, $part, 2;
$key //= '';
$val //= '';
# URL decode (handles + as space)
my $key_decoded = _url_decode($key);
my $val_decoded = _url_decode($val);
# UTF-8 decode unless raw mode
my $key_final = $raw ? $key_decoded : _decode_utf8($key_decoded, $strict);
my $val_final = $raw ? $val_decoded : _decode_utf8($val_decoded, $strict);
push @pairs, $key_final, $val_final;
}
$self->{scope}{$cache_key} = Hash::MultiValue->new(@pairs);
return $self->{scope}{$cache_key};
}
# DEPRECATED: Alias with warning
async sub form {
my $self = shift;
carp "form() is deprecated; use form_params() instead";
return await $self->form_params(@_);
}
# Singular accessor for form params
async sub form_param {
my ($self, $name, %opts) = @_;
my $form = await $self->form_params(%opts);
return $form->get($name);
}
# Raw form params (no UTF-8 decoding)
async sub raw_form_params {
my ($self, %opts) = @_;
return await $self->form_params(%opts, raw => 1);
}
# DEPRECATED: Alias with warning
async sub raw_form {
my $self = shift;
carp "raw_form() is deprecated; use raw_form_params() instead";
return await $self->raw_form_params(@_);
}
# Raw singular accessor
async sub raw_form_param {
my ($self, $name) = @_;
return await $self->form_param($name, raw => 1);
}
# Parse multipart form (internal, cached in scope)
async sub _parse_multipart_form {
my ($self, %opts) = @_;
croak "Body streaming already started; buffered helpers unavailable"
if $self->{scope}{'pagi.request.body.stream.created'};
# Already parsed?
return $self->{scope}{'pagi.request.form'}
if $self->{scope}{'pagi.request.form'} && $self->{scope}{'pagi.request.uploads'};
# Extract boundary from content-type
my $ct = $self->header('content-type') // '';
my ($boundary) = $ct =~ /boundary=([^;\s]+)/;
$boundary =~ s/^["']|["']$//g if $boundary; # Strip quotes
die "No boundary found in Content-Type" unless $boundary;
my $handler = PAGI::Request::MultiPartHandler->new(
boundary => $boundary,
receive => $self->{receive},
max_field_size => $opts{max_field_size},
max_file_size => $opts{max_file_size},
spool_threshold => $opts{spool_threshold},
max_files => $opts{max_files},
max_fields => $opts{max_fields},
temp_dir => $opts{temp_dir},
);
my ($form, $uploads) = await $handler->parse;
$self->{scope}{'pagi.request.form'} = $form;
$self->{scope}{'pagi.request.uploads'} = $uploads;
$self->{scope}{'pagi.request.body.read'} = 1; # Body has been consumed
return $form;
}
# Get all uploads as Hash::MultiValue (cached in scope)
async sub uploads {
my ($self, %opts) = @_;
return $self->{scope}{'pagi.request.uploads'} if $self->{scope}{'pagi.request.uploads'};
if ($self->is_multipart) {
await $self->_parse_multipart_form(%opts);
return $self->{scope}{'pagi.request.uploads'};
}
# Not multipart - return empty
$self->{scope}{'pagi.request.uploads'} = Hash::MultiValue->new();
return $self->{scope}{'pagi.request.uploads'};
}
# Get single upload by field name
async sub upload {
my ($self, $name, %opts) = @_;
my $uploads = await $self->uploads(%opts);
return $uploads->get($name);
}
# Get all uploads for a field name
async sub upload_all {
my ($self, $name, %opts) = @_;
my $uploads = await $self->uploads(%opts);
lib/PAGI/Request.pm view on Meta::CPAN
# Route defines :userId but you typed :user_id
my $id = $req->path_param('user_id');
# Dies: "path_param 'user_id' not found. Available: userId, postId"
B<Options:>
=over 4
=item * C<strict> - If false, return C<undef> for missing parameters instead
of dying. Default: true.
=back
=head2 Strict Mode
By default, C<path_params> returns an empty hashref if no router has set
C<< $scope->{path_params} >>. This is the safest behavior for middleware and
handlers that may run with or without a router.
To catch configuration errors early, pass C<< strict => 1 >>:
# Dies if no router populated the scope:
my $params = $req->path_params(strict => 1);
# "path_params not set in scope (no router configured?)"
C<path_param> (singular) is strict by default for the requested key, so asking
for a parameter when no router ran also dies, naming the missing key:
my $id = $req->path_param('id');
# "path_param 'id' not found. ... No path params set (no router?)"
This matches Starlette's behavior of returning an empty dict by default, while
letting you opt into a loud failure per call.
=head1 COOKIES
=head2 cookies
my $cookies = $req->cookies; # hashref
Get all cookies.
=head2 cookie
my $session = $req->cookie('session');
Get a single cookie value.
=head1 BODY METHODS (ASYNC)
=head2 body_stream
my $stream = $req->body_stream;
my $stream = $req->body_stream(
max_bytes => 10 * 1024 * 1024, # 10MB limit
decode => 'UTF-8', # Decode to UTF-8
strict => 1, # Strict UTF-8 decoding
);
Returns a L<PAGI::Request::BodyStream> for streaming body consumption. This is
useful for processing large request bodies incrementally without loading them
entirely into memory.
B<Options:>
=over 4
=item * C<max_bytes> - Maximum body size. Defaults to Content-Length header if present.
=item * C<decode> - Encoding to decode chunks to (typically 'UTF-8').
=item * C<strict> - If true, throw on invalid UTF-8. Default: false (use replacement chars).
=back
B<Important:> Body streaming is mutually exclusive with buffered body methods
(C<body>, C<text>, C<json>, C<form_params>). Once you start streaming, you cannot use
those methods, and vice versa.
Example:
# Stream large upload to file
my $stream = $req->body_stream(max_bytes => 100 * 1024 * 1024);
await $stream->stream_to_file('/uploads/data.bin');
See L<PAGI::Request::BodyStream> for full documentation.
=head2 multipart_stream
my $stream = $req->multipart_stream;
my $stream = $req->multipart_stream(
max_files => 1000,
max_fields => 1000,
max_field_size => 1024 * 1024,
max_file_size => 100 * 1024 * 1024,
max_request_body => 1024 * 1024 * 1024,
);
Returns a L<PAGI::Request::MultipartStream> for pull-based streaming of a
C<multipart/form-data> request body. You pull one part at a time and choose
where each one goes:
while (defined(my $part = await $stream->next)) {
if ($part->is_file) {
await $part->stream_to_file($path);
}
else {
my $value = await $part->value; # raw bytes; you decode
}
}
Each part is a L<PAGI::Request::Part> exposing its metadata (C<name>,
C<filename>, C<content_type>, C<headers>, C<is_file>) and methods to consume
its body: C<next_chunk> (pull raw bytes), C<value> (buffer the whole part as
raw bytes), C<stream_to($cb)> (drain to a possibly-async sink), and
C<stream_to_file($path)> (write to a new file, path-safe).
Unlike the buffered multipart path (C<form_params>/C<uploads>), this does
B<not> spool each upload to a temp file: the application owns the sink, so a
part can stream straight to an object store or a transform, and that sink can
be fully asynchronous (C<stream_to> awaits a Future-returning sink for
backpressure) -- whereas the buffered spool is blocking.
B<Options:>
=over 4
=item * C<max_files> - Maximum number of file parts. Default: 1000.
=item * C<max_fields> - Maximum number of field parts. Default: 1000.
=item * C<max_field_size> - Maximum bytes per field part. Default: 1 MiB.
=item * C<max_file_size> - Maximum bytes per file part. Default: 100 MiB.
=item * C<max_request_body> - Maximum total body bytes (per-stream
defence-in-depth; the server's C<max_body_size> is the primary cap).
Default: 1 GiB.
=back
B<Important:> Streaming the multipart body is mutually exclusive with the
buffered body methods. C<multipart_stream> croaks if the body was already read
or a stream was already created, and conversely C<body>/C<text>/C<json>/
C<form_params>/C<uploads> croak once a stream exists -- a body can only be
consumed once.
See L<PAGI::Request::MultipartStream> for full documentation.
=head2 body
my $bytes = await $req->body;
Read raw body bytes. Cached after first read.
B<Important:> Cannot be used after C<body_stream()> has been called.
=head2 text
lib/PAGI/Request.pm view on Meta::CPAN
=head2 disconnect_reason
my $reason = $req->disconnect_reason;
Returns the disconnect reason string, or C<undef> if still connected.
Standard reasons include: C<client_closed>, C<client_timeout>, C<idle_timeout>,
C<write_error>, C<read_error>, C<protocol_error>, C<server_shutdown>,
C<body_too_large>.
See L<PAGI::Server::ConnectionState/disconnect_reason> for the full list.
=head2 on_disconnect
$req->on_disconnect(sub {
my ($reason) = @_;
rollback();
log_info("Client disconnected: $reason");
});
Registers a callback invoked B<only on an abnormal disconnect> (the client
goes away, a timeout fires, an error occurs) -- not on a clean finish. The
callback receives the disconnect reason. Multiple callbacks may be registered;
if the client has already disconnected, the callback is invoked immediately.
Returns the request for chaining. The counterpart to L</on_complete>: exactly
one of the two fires per request.
=head2 on_complete
$req->on_complete(sub {
commit();
});
Registers a callback invoked B<only when the request completes successfully>
(the response was fully delivered without the client disconnecting). Multiple
callbacks may be registered; if the request has already completed, the callback
is invoked immediately. Returns the request for chaining. The counterpart to
L</on_disconnect>.
=head2 disconnect_future
my $future = $req->disconnect_future;
if ($future) {
# Race against other operations
await Future->wait_any($disconnect_future, $event_future);
}
Returns a Future that resolves when the client disconnects, or C<undef>
if not supported. The Future resolves with the disconnect reason string.
This is useful for racing against other async operations.
=head2 buffered_amount, high_water_mark, low_water_mark
my $pending = $req->buffered_amount; # bytes queued, not yet on the wire
my $ceiling = $req->high_water_mark; # backpressure ceiling (or undef)
my $floor = $req->low_water_mark; # backpressure floor (or undef)
Outbound flow-control introspection, delegated to the server-provided
C<pagi.transport> handle (see L<PAGI::Spec::Www/"Transport Flow Control">). For a
streaming response, use C<buffered_amount> to conflate or shed load instead of
only blocking on drain; when the server does not provide the handle,
C<buffered_amount> returns C<0> and the watermarks return C<undef>.
=head2 on_high_water, on_drain, is_writable
$req->on_high_water(sub { $source->pause }); # backpressure engaged
$req->on_drain(sub { $source->resume }); # backpressure cleared
last unless $req->is_writable; # below the high mark?
Backpressure controls delegated to the C<pagi.transport> handle. C<on_high_water>
and C<on_drain> register edge-triggered callbacks (the Node/Mojo C<drain> model)
for producers that cannot self-pace with a blocking send; each returns the
object for chaining. C<is_writable> is true when the outbound buffer is below the
high mark. When the server provides no transport handle (or only the read
methods), the callbacks are quiet no-ops and C<is_writable> is true.
=head1 AUTH HELPERS
=head2 bearer_token
my $token = $req->bearer_token;
Extract Bearer token from Authorization header.
=head2 basic_auth
my ($user, $pass) = $req->basic_auth;
Decode Basic auth credentials.
=head2 scope
my $scope = $req->scope;
Returns the raw PAGI scope hashref. Useful for constructing helper
objects like L<PAGI::Stash> and L<PAGI::Session>:
my $stash = PAGI::Stash->new($req);
=head2 response
my $res = $req->response;
Vends a detached L<PAGI::Response> bound to this request's scope: the
raw-application analog of C<< $ctx->response >>. The response is a value, not a
connection; build it up and send it with C<< $res->respond($send) >>:
await $req->response->status(201)->json($data)->respond($send);
=head2 Per-Request Shared State
See L<PAGI::Stash> for per-request shared state between middleware
and handlers. Construct from a Request object or scope:
use PAGI::Stash;
my $stash = PAGI::Stash->new($req);
$stash->set(user => $current_user);
=cut
( run in 0.904 second using v1.01-cache-2.11-cpan-6aa56a78535 )