File Coverage

blib/lib/PAGI/Middleware/Debug.pm
Criterion Covered Total %
statement 95 102 93.1
branch 20 26 76.9
condition 19 26 73.0
subroutine 11 11 100.0
pod 1 1 100.0
total 146 166 87.9


line stmt bran cond sub pod time code
1             package PAGI::Middleware::Debug;
2              
3 2     2   340991 use strict;
  2         3  
  2         62  
4 2     2   12 use warnings;
  2         4  
  2         89  
5 2     2   611 use parent 'PAGI::Middleware';
  2         576  
  2         9  
6 2     2   105 use Future::AsyncAwait;
  2         3  
  2         6  
7 2     2   83 use Time::HiRes qw(time);
  2         2  
  2         10  
8 2     2   877 use JSON::MaybeXS ();
  2         20414  
  2         2948  
9              
10             =head1 NAME
11              
12             PAGI::Middleware::Debug - Development debug panel middleware
13              
14             =head1 SYNOPSIS
15              
16             use PAGI::Middleware::Builder;
17              
18             my $app = builder {
19             enable 'Debug',
20             enabled => $ENV{PAGI_DEBUG};
21             $my_app;
22             };
23              
24             =head1 DESCRIPTION
25              
26             PAGI::Middleware::Debug injects a debug panel into HTML responses
27             showing request/response details, timing breakdown, and headers.
28             Only enabled in development mode.
29              
30             =head1 CONFIGURATION
31              
32             =over 4
33              
34             =item * enabled (default: 0)
35              
36             Enable the debug panel. Should only be true in development.
37              
38             =item * show_headers (default: 1)
39              
40             Show request/response headers in debug panel.
41              
42             =item * show_scope (default: 1)
43              
44             Show scope contents in debug panel.
45              
46             =item * show_timing (default: 1)
47              
48             Show timing breakdown in debug panel.
49              
50             =back
51              
52             =cut
53              
54             sub _init {
55 4     4   11 my ($self, $config) = @_;
56              
57 4   50     24 $self->{enabled} = $config->{enabled} // 0;
58 4   100     26 $self->{show_headers} = $config->{show_headers} // 1;
59 4   100     17 $self->{show_scope} = $config->{show_scope} // 1;
60 4   100     19 $self->{show_timing} = $config->{show_timing} // 1;
61             }
62              
63             sub wrap {
64 4     4 1 51 my ($self, $app) = @_;
65              
66 4     4   101 return async sub {
67 4         14 my ($scope, $receive, $send) = @_;
68             # Skip if not enabled or not HTTP
69 4 100 66     23 if (!$self->{enabled} || $scope->{type} ne 'http') {
70 1         5 await $app->($scope, $receive, $send);
71 1         158 return;
72             }
73              
74 3         9 my $start_time = time();
75 3         25 my $response_status;
76             my @response_headers;
77 3         64 my $body = '';
78 3         4 my $is_html = 0;
79 3         6 my $headers_sent = 0;
80              
81             # Wrap send to capture response and inject panel
82 6         244 my $wrapped_send = async sub {
83 6         10 my ($event) = @_;
84 6 100       18 if ($event->{type} eq 'http.response.start') {
85 3         5 $response_status = $event->{status};
86 3   50     4 @response_headers = @{$event->{headers} // []};
  3         11  
87              
88             # Check if HTML response
89 3         7 for my $h (@response_headers) {
90 3 100 66     40 if (lc($h->[0]) eq 'content-type' && $h->[1] =~ m{text/html}i) {
91 2         4 $is_html = 1;
92 2         4 last;
93             }
94             }
95              
96             # If HTML, buffer; otherwise pass through
97 3 100       7 if (!$is_html) {
98 1         3 $headers_sent = 1;
99 1         3 await $send->($event);
100             }
101 3         100 return;
102             }
103              
104 3 50       9 if ($event->{type} eq 'http.response.body') {
105 3 100 66     13 if ($is_html && !$headers_sent) {
106             # Buffer body
107 2   50     7 $body .= $event->{body} // '';
108              
109             # If this is the final chunk, inject panel
110 2 50       6 if (!$event->{more}) {
111 2         8 my $panel = $self->_build_panel($scope, $start_time, $response_status, \@response_headers);
112              
113             # Inject before or at end
114 2 50       31 if ($body =~ s{()}{$panel$1}i) {
115             # Injected before
116             } else {
117 0         0 $body .= $panel;
118             }
119              
120             # Update Content-Length if present
121 2         9 for my $h (@response_headers) {
122 2 50       9 if (lc($h->[0]) eq 'content-length') {
123 0         0 $h->[1] = length($body);
124 0         0 last;
125             }
126             }
127              
128 2         4 $headers_sent = 1;
129 2         10 await $send->({
130             type => 'http.response.start',
131             status => $response_status,
132             headers => \@response_headers,
133             });
134 2         100 await $send->({
135             type => 'http.response.body',
136             body => $body,
137             more => 0,
138             });
139             }
140             } else {
141 1         3 await $send->($event);
142             }
143 3         94 return;
144             }
145              
146 0         0 await $send->($event);
147 3         13 };
148              
149 3         10 await $app->($scope, $receive, $wrapped_send);
150 4         25 };
151             }
152              
153             sub _build_panel {
154 2     2   5 my ($self, $scope, $start_time, $status, $response_headers) = @_;
155              
156 2         24 my $duration = sprintf("%.3f", (time() - $start_time) * 1000);
157              
158 2         4 my $html = qq{
159            
198            
199            

PAGI Debug Panel
200            
201             };
202              
203             # Timing section
204 2 100       8 if ($self->{show_timing}) {
205 1         3 $html .= qq{
206            
207            
Timing
208            
209            
Total Time${duration}ms
210            
Status$status
211            
212            
213             };
214             }
215              
216             # Request section
217 2 50       6 if ($self->{show_scope}) {
218 2         7 my $method = _html_escape($scope->{method});
219 2         5 my $path = _html_escape($scope->{path});
220 2         4 my $query = _html_escape($scope->{query_string});
221 2         4 my $scheme = _html_escape($scope->{scheme});
222 2         8 $html .= qq{
223            
224            
Request
225            
226            
Method$method
227            
Path$path
228            
Query$query
229            
Scheme$scheme
230            
231            
232             };
233             }
234              
235             # Request headers section
236 2 50 66     9 if ($self->{show_headers} && $scope->{headers}) {
237 1         3 $html .= qq{
238            
239            
Request Headers
240             \n};
241             };
242 1         1 for my $h (@{$scope->{headers}}) {
  1         3  
243 0         0 my $name = _html_escape($h->[0]);
244 0         0 my $value = _html_escape($h->[1]);
245 0         0 $html .= qq{
$name$value
246             }
247 1         2 $html .= qq{
};
248             }
249              
250             # Response headers section
251 2 100       28 if ($self->{show_headers}) {
252 1         2 $html .= qq{
253            
254            
Response Headers
255             \n};
256             };
257 1         2 for my $h (@$response_headers) {
258 1         2 my $name = _html_escape($h->[0]);
259 1         2 my $value = _html_escape($h->[1]);
260 1         2 $html .= qq{
$name$value
261             }
262 1         2 $html .= qq{
};
263             }
264              
265 2         2 $html .= qq{
266            
267            
268             };
269              
270 2         5 return $html;
271             }
272              
273             sub _html_escape {
274 10   100 10   21 my $str = shift // '';
275 10         13 $str =~ s/&/&/g;
276 10         14 $str =~ s/
277 10         16 $str =~ s/>/>/g;
278 10         17 $str =~ s/"/"/g;
279 10         14 return $str;
280             }
281              
282             1;
283              
284             __END__