File Coverage

blib/lib/PAGI/Endpoint/HTTP.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch	13	16	81.2
condition	11	19	57.8
subroutine	11	11	100.0
pod	4	5	80.0
total	89	101	88.1

package PAGI::Endpoint::HTTP;
$PAGI::Endpoint::HTTP::VERSION = '0.002000';
use strict;
use warnings;

use Future::AsyncAwait;
use Carp qw(croak);
use Scalar::Util qw(blessed);

# Factory class method - override in subclass for customization
sub context_class { 'PAGI::Context' }

sub new {
    my ($class, %args) = @_;
    return bless \%args, $class;
}

# HTTP methods we support
our @HTTP_METHODS = qw(get post put patch delete head options);

sub allowed_methods {
    my ($self) = @_;
    my @allowed;
    for my $method (@HTTP_METHODS) {
        push @allowed, uc($method) if $self->can($method);
    }
    # HEAD is allowed if GET is defined
    push @allowed, 'HEAD' if $self->can('get') && !$self->can('head');
    # OPTIONS is always allowed
    push @allowed, 'OPTIONS' unless grep { $_ eq 'OPTIONS' } @allowed;
    return sort @allowed;
}

async sub dispatch {
    my ($self, $ctx) = @_;
    my $http_method = lc($ctx->method // 'GET');

    my $res;

    # OPTIONS - return allowed methods (auto-respond unless overridden)
    if ($http_method eq 'options' && !$self->can('options')) {
        my $allow = join(', ', $self->allowed_methods);
        $res = $ctx->response->header('Allow', $allow)->empty;
    }
    # HEAD falls back to GET if not explicitly defined
    elsif ($http_method eq 'head' && !$self->can('head') && $self->can('get')) {
        $res = await $self->get($ctx);
    }
    # Dispatch to the appropriate method handler
    elsif ($self->can($http_method)) {
        $res = await $self->$http_method($ctx);
    }
    # 405 Method Not Allowed
    else {
        my $allow = join(', ', $self->allowed_methods);
        $res = $ctx->response->header('Allow', $allow)->status(405)->text("405 Method Not Allowed");
    }

    croak ref($self) . "->$http_method did not return a response"
        unless blessed($res) && $res->can('respond');
    await $ctx->respond($res);
}

sub to_app {
    my ($class) = @_;
    my $context_class = $class->context_class;
    my $endpoint = $class->new;    # ONE instance for the app lifetime (singleton)

    return async sub {
        my ($scope, $receive, $send) = @_;

        my $type = $scope->{type} // 'http';
        croak "Expected http scope, got '$type'" unless $type eq 'http';

        require PAGI::Context;
        my $ctx = $context_class->new($scope, $receive, $send);

        await $endpoint->dispatch($ctx);
    };
}

1;

__END__