view release on metacpan or  search on metacpan

lib/PAGI/Request.pm  view on Meta::CPAN

sub bearer_token {
    my $self = shift;
    my $auth = $self->header('authorization') // '';
    if ($auth =~ /^Bearer\s+(.+)$/i) {
        return $1;
    }
    return undef;
}

# Extract Basic auth credentials
sub basic_auth {
    my $self = shift;
    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 = shift;
    my $params = $self->{scope}{path_params};
    if (!defined $params && $CONFIG{path_param_strict}) {
        croak "path_params not set in scope (no router configured?). "
            . "Set PAGI::Request->configure(path_param_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} }


# 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},
    );
}

# 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 $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> and C<path_param> return empty values 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.

If you want to catch configuration errors early, enable strict mode:

    PAGI::Request->configure(path_param_strict => 1);

With strict mode enabled, calling C<path_params> or C<path_param> when
C<< $scope->{path_params} >> is undefined will die with an error message.
This helps catch bugs where you expect a router but one isn't configured.

    # Strict mode: dies if no router set path_params
    PAGI::Request->configure(path_param_strict => 1);

    my $id = $req->path_param('id');
    # Dies: "path_params not set in scope (no router configured?)"

The default is C<path_param_strict =E<gt> 0> (non-strict), which matches
Starlette's behavior of returning an empty dict when path_params is not set.

=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 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

    my $text = await $req->text;

Read body as UTF-8 decoded text.

=head2 json

    my $data = await $req->json;

Parse body as JSON. Dies on parse error.

=head2 form_params

    my $form = await $req->form_params;  # Hash::MultiValue
    my $form = await $req->form_params(strict => 1);  # Die on invalid UTF-8
    my $form = await $req->form_params(raw => 1);     # Skip UTF-8 decoding

Parse URL-encoded or multipart form data, returning a L<Hash::MultiValue>.

B<Options:>

=over 4

=item * C<strict> - If true, die on invalid UTF-8 sequences. Default: false.

=item * C<raw> - If true, skip UTF-8 decoding entirely. Default: false.

=back

=head2 form_param

    my $value = await $req->form_param('name');
    my $value = await $req->form_param('name', strict => 1);

Shortcut for C<< (await $req->form_params(%opts))->get($name) >>. Accepts the
same C<strict> and C<raw> options as C<form_params>.

=head2 raw_form_params

    my $form = await $req->raw_form_params;