PAGI
view release on metacpan or search on metacpan
lib/PAGI/Middleware/GZip.pm view on Meta::CPAN
MIME types to compress.
=back
=cut
sub _init {
my ($self, $config) = @_;
$self->{min_size} = $config->{min_size} // 1024;
$self->{mime_types} = $config->{mime_types} // [
'text/html', 'text/plain', 'text/css', 'text/javascript',
'application/json', 'application/javascript', 'application/xml',
];
}
sub wrap {
my ($self, $app) = @_;
return async sub {
my ($scope, $receive, $send) = @_;
if ($scope->{type} ne 'http') {
await $app->($scope, $receive, $send);
return;
}
# Check if client accepts gzip
my $accept_encoding = $self->_get_header($scope, 'accept-encoding') // '';
my $accepts_gzip = $accept_encoding =~ /\bgzip\b/i;
unless ($accepts_gzip) {
await $app->($scope, $receive, $send);
return;
}
# Buffer response to compress
# NOTE: All request-specific state MUST be lexical variables, not instance
# state ($self->{}), because middleware instances are shared across
# concurrent requests. Using $self->{} would cause race conditions.
my @body_parts;
my $response_started = 0;
my $content_type = '';
my $original_headers;
my $headers_sent = 0; # Request-local state (NOT on $self!)
my $wrapped_send = async sub {
my ($event) = @_;
if ($event->{type} eq 'http.response.start') {
$original_headers = $event->{headers};
# Get content type
for my $h (@{$event->{headers} // []}) {
if (lc($h->[0]) eq 'content-type') {
$content_type = $h->[1];
last;
}
}
$response_started = 1;
# Don't send yet - buffer to compress
}
elsif ($event->{type} eq 'http.response.body') {
# If we're already in streaming mode, pass through all chunks
if ($headers_sent) {
await $send->($event);
return;
}
push @body_parts, $event->{body} // '';
# If streaming (more => 1), switch to pass-through mode
if ($event->{more}) {
if (!$headers_sent) {
await $send->({
type => 'http.response.start',
status => 200,
headers => $original_headers,
});
$headers_sent = 1;
}
await $send->($event);
}
}
else {
await $send->($event);
}
};
await $app->($scope, $receive, $wrapped_send);
# If headers already sent (streaming), we're done
return if $headers_sent;
# Combine body
my $body = join('', @body_parts);
# Decide whether to compress
my $should_compress = $self->_should_compress($content_type, length($body));
if ($should_compress && length($body) > 0) {
my $compressed;
gzip(\$body, \$compressed) or die "gzip failed: $GzipError";
# Update headers
my @new_headers;
for my $h (@{$original_headers // []}) {
next if lc($h->[0]) eq 'content-length';
push @new_headers, $h;
}
push @new_headers, ['Content-Encoding', 'gzip'];
push @new_headers, ['Content-Length', length($compressed)];
push @new_headers, ['Vary', 'Accept-Encoding'];
await $send->({
type => 'http.response.start',
status => 200,
headers => \@new_headers,
});
await $send->({
type => 'http.response.body',
body => $compressed,
more => 0,
});
}
else {
await $send->({
type => 'http.response.start',
status => 200,
headers => $original_headers,
});
await $send->({
type => 'http.response.body',
body => $body,
more => 0,
});
}
};
}
sub _should_compress {
my ($self, $content_type, $size) = @_;
return 0 if $size < $self->{min_size};
$content_type =~ s/;.*//; # Remove charset etc.
$content_type = lc($content_type);
for my $type (@{$self->{mime_types}}) {
return 1 if $content_type eq lc($type);
if ($type =~ /\*$/) {
my $prefix = substr($type, 0, -1);
( run in 0.880 second using v1.01-cache-2.11-cpan-140bd7fdf52 )