File Coverage

blib/lib/Mojo/Server/AWSLambda/Request.pm
Criterion Covered Total %
statement 43 49 87.7
branch 4 10 40.0
condition 5 10 50.0
subroutine 7 7 100.0
pod 1 1 100.0
total 60 77 77.9


line stmt bran cond sub pod time code
1             package Mojo::Server::AWSLambda::Request;
2              
3              
4 2     2   17 use Mojo::Base 'Mojo::Message::Request';
  2         4  
  2         13  
5 2     2   125736 use MIME::Base64;
  2         6  
  2         1574  
6              
7             sub parse {
8 1     1 1 9 my ($self, $env) = @_;
9 1         5 $self->_parse_env($env);
10 1         63 return $self;
11             }
12              
13             sub _parse_env {
14 1     1   4 my ($self, $payload) = @_;
15              
16 1         5 my $url = $self->url;
17              
18 1         30 $self->method($payload->{httpMethod});
19 1         11 $url->scheme('http');
20 1         58 $url->path($payload->{path});
21              
22 1         95 $self->_extract_headers($payload);
23 1         32 $self->_extract_query($payload);
24 1         84 $self->_extract_body($payload);
25             }
26              
27             sub _extract_headers {
28 1     1   3 my ($self, $payload) = @_;
29              
30             # Header prefix
31              
32 1         8 my $headers = $self->headers;
33 1         73 my $url = $self->url;
34 1         13 my $base = $url->base;
35            
36             my $lambda_headers = {
37 1   50     9 %{$payload->{headers} // {}},
38 1   50     14 %{$payload->{multiValueHeaders} // {}},
  1         17  
39             };
40              
41 1         11 while (my ($key, $value) = each %$lambda_headers) {
42 12         300 $key =~ s/-/_/g;
43 12         32 $key = uc $key;
44 12 50       25 if (ref $value eq "ARRAY") {
45 0         0 $value = join ", ", @$value;
46             }
47              
48 12 50       27 if ($key =~ /^(?:CONTENT_LENGTH|CONTENT_TYPE)$/) {
49 0         0 my $accessor = lc($key);
50 0 0       0 $headers->$accessor($value) if defined $value;
51             }
52              
53 12         29 $headers->header($key => $value);
54             }
55             }
56              
57             sub _extract_query {
58 1     1   3 my ($self, $payload) = @_;
59              
60              
61             my $query = {
62 1   50     7 %{$payload->{queryStringParameters} // {}},
63 1   50     3 %{$payload->{multiValueQueryStringParameters} // {}},
  1         10  
64             };
65 1         3 my @params;
66 1         6 while (my ($key, $value) = each %$query) {
67 1 50       4 if (ref($value) eq 'ARRAY') {
68 0         0 for my $v (@$value) {
69 0         0 push @params, "$key=$v";
70             }
71             } else {
72 1         6 push @params, "$key=$value";
73             }
74             }
75              
76 1         4 $self->url->query(join '&', @params);
77             }
78              
79             sub _extract_body {
80 1     1   4 my ($self, $payload) = @_;
81              
82 1   50     4 my $body = $payload->{body} // "";
83 1 50       29 if ($payload->{isBase64Encoded}) {
84 0         0 $body = decode_base64 $body;
85             }
86              
87 1         15 $self->body($body);
88             }
89              
90             1;