File Coverage

blib/lib/PAGI/Endpoint/HTTP.pm
Criterion Covered Total %
statement 53 53 100.0
branch 13 16 81.2
condition 9 16 56.2
subroutine 12 12 100.0
pod 4 5 80.0
total 91 102 89.2


line stmt bran cond sub pod time code
1             package PAGI::Endpoint::HTTP;
2             $PAGI::Endpoint::HTTP::VERSION = '0.002001';
3 7     7   1024420 use strict;
  7         12  
  7         287  
4 7     7   33 use warnings;
  7         33  
  7         294  
5              
6 7     7   29 use Future::AsyncAwait;
  7         9  
  7         36  
7 7     7   318 use Carp qw(croak);
  7         13  
  7         342  
8 7     7   32 use Scalar::Util qw(blessed);
  7         6  
  7         237  
9 7     7   2224 use PAGI::Utils qw(is_response);
  7         12  
  7         4932  
10              
11             # Factory class method - override in subclass for customization
12 10     10 1 4272 sub context_class { 'PAGI::Context' }
13              
14             sub new {
15 16     16 0 354837 my ($class, %args) = @_;
16 16         39 return bless \%args, $class;
17             }
18              
19             # HTTP methods we support
20             our @HTTP_METHODS = qw(get post put patch delete head options);
21              
22             sub allowed_methods {
23 6     6 1 11 my ($self) = @_;
24 6         10 my @allowed;
25 6         12 for my $method (@HTTP_METHODS) {
26 42 100       131 push @allowed, uc($method) if $self->can($method);
27             }
28             # HEAD is allowed if GET is defined
29 6 50 33     41 push @allowed, 'HEAD' if $self->can('get') && !$self->can('head');
30             # OPTIONS is always allowed
31 6 50       12 push @allowed, 'OPTIONS' unless grep { $_ eq 'OPTIONS' } @allowed;
  19         34  
32 6         39 return sort @allowed;
33             }
34              
35 13     13 1 116 async sub dispatch {
36 13         19 my ($self, $ctx) = @_;
37 13   50     39 my $http_method = lc($ctx->method // 'GET');
38              
39 13         96 my $res;
40              
41             # OPTIONS - return allowed methods (auto-respond unless overridden)
42 13 100 66     150 if ($http_method eq 'options' && !$self->can('options')) {
    100 66        
    100 66        
43 2         7 my $allow = join(', ', $self->allowed_methods);
44 2         8 $res = $ctx->response->header('Allow', $allow)->empty;
45             }
46             # HEAD falls back to GET if not explicitly defined
47             elsif ($http_method eq 'head' && !$self->can('head') && $self->can('get')) {
48 1         3 $res = await $self->get($ctx);
49             }
50             # Dispatch to the appropriate method handler
51             elsif ($self->can($http_method)) {
52 7         22 $res = await $self->$http_method($ctx);
53             }
54             # 405 Method Not Allowed
55             else {
56 3         15 my $allow = join(', ', $self->allowed_methods);
57 3         11 $res = $ctx->response->header('Allow', $allow)->status(405)->text("405 Method Not Allowed");
58             }
59              
60 13 100       401 croak ref($self) . "->$http_method did not return a response"
61             unless is_response($res);
62 12         39 await $ctx->respond($res);
63             }
64              
65             sub to_app {
66 8     8 1 359701 my ($class) = @_;
67 8         33 my $context_class = $class->context_class;
68 8         27 my $endpoint = $class->new; # ONE instance for the app lifetime (singleton)
69              
70 7     7   160 return async sub {
71 7         11 my ($scope, $receive, $send) = @_;
72              
73 7   50     18 my $type = $scope->{type} // 'http';
74 7 50       15 croak "Expected http scope, got '$type'" unless $type eq 'http';
75              
76 7         1089 require PAGI::Context;
77 7         40 my $ctx = $context_class->new($scope, $receive, $send);
78              
79 7         28 await $endpoint->dispatch($ctx);
80 8         38 };
81             }
82              
83             1;
84              
85             __END__