Skip to content

Commit 01c9869

Browse files
mikkoimikkoi
committed
Add support for Zstandard compression
* Use IO::Compress::Zstd instead of Compress::Zstd because the latter has no GitHub activity from the part of the developer since 2019. * Issue: #205
1 parent 402059a commit 01c9869

File tree

5 files changed

+165
-1
lines changed

5 files changed

+165
-1
lines changed

‎lib/HTTP/Message.pm‎

Lines changed: 36 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ our $VERSION = '7.02';
77

88
require HTTP::Headers;
99
require Carp;
10+
use Module::Load ();
11+
use Module::Load::Conditional ();
1012

1113
our $MAXIMUM_BODY_SIZE;
1214

@@ -354,6 +356,25 @@ sub decoded_content
354356
$content_ref = \$output;
355357
$content_ref_iscopy++;
356358
}
359+
elsif ($ce eq 'zstd') {
360+
Module::Load::load('IO::Uncompress::UnZstd');
361+
my $buffer;
362+
my $z;
363+
if( defined $content_limit ) {
364+
$z = IO::Uncompress::UnZstd->new( $content_ref, InputLength => $content_limit, Append => 1, Strict => 1, )
365+
or Carp::croak "IO::Compress::Zstd->new failed: $IO::Uncompress::UnZstd::UnZstdError\n";
366+
} else {
367+
$z = IO::Uncompress::UnZstd->new( $content_ref, Append => 1, Strict => 1, )
368+
or Carp::croak "IO::Compress::Zstd->new failed: $IO::Uncompress::UnZstd::UnZstdError\n";
369+
}
370+
my $status;
371+
while( $status = $z->read($buffer) > 0 ) { }
372+
if( $status < 0 ) {
373+
Carp::croak "IO::Compress::Zstd::read failed: $IO::Uncompress::UnZstd::UnZstdError\n";
374+
}
375+
$content_ref = \$buffer;
376+
$content_ref_iscopy++;
377+
}
357378
elsif ($ce eq "x-bzip2" or $ce eq "bzip2") {
358379
require Compress::Raw::Bzip2;
359380

@@ -509,6 +530,9 @@ sub decodable
509530
require IO::Uncompress::Brotli;
510531
push(@enc, 'br');
511532
};
533+
if( Module::Load::Conditional::check_install( module => 'IO::Compress::Zstd') ) {
534+
push(@enc, "zstd");
535+
}
512536
# we don't care about announcing the 'identity', 'base64' and
513537
# 'quoted-printable' stuff
514538
return wantarray ? @enc : join(", ", @enc);
@@ -577,6 +601,16 @@ sub encode
577601
elsif ($encoding eq "rot13") { # for the fun of it
578602
$content =~ tr/A-Za-z/N-ZA-Mn-za-m/;
579603
}
604+
elsif ($encoding eq 'zstd') {
605+
Module::Load::load('IO::Compress::Zstd');
606+
my $output;
607+
my $z = IO::Compress::Zstd->new( \$output, Level => 3, Append => 0, Strict => 1, )
608+
or Carp::croak "IO::Compress::Zstd failed: $IO::Compress::Zstd::ZstdError\n";
609+
$z->write($content)
610+
or Carp::croak "IO::Compress::Zstd::write failed: $IO::Compress::Zstd::ZstdError\n";
611+
$z->flush();
612+
$content = $output;
613+
}
580614
else {
581615
return 0;
582616
}
@@ -1062,7 +1096,8 @@ want to process its content as a string.
10621096
Apply the given encodings to the content of the message. Returns TRUE
10631097
if successful. The "identity" (non-)encoding is always supported; other
10641098
currently supported encodings, subject to availability of required
1065-
additional modules, are "gzip", "deflate", "x-bzip2", "base64" and "br".
1099+
additional modules, are "gzip", "deflate", "x-bzip2", "br", "zstd"
1100+
and "base64".
10661101
10671102
A successful call to this function will set the C<Content-Encoding>
10681103
header.

‎t/files/lorem_ipsum.txt‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
The standard Lorem Ipsum passage, used since the 1500s
2+
3+
"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
4+
Section 1.10.32 of "de Finibus Bonorum et Malorum", written by Cicero in 45 BC
5+
6+
"Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"
7+
1914 translation by H. Rackham
8+
9+
"But I must explain to you how all this mistaken idea of denouncing pleasure and praising pain was born and I will give you a complete account of the system, and expound the actual teachings of the great explorer of the truth, the master-builder of human happiness. No one rejects, dislikes, or avoids pleasure itself, because it is pleasure, but because those who do not know how to pursue pleasure rationally encounter consequences that are extremely painful. Nor again is there anyone who loves or pursues or desires to obtain pain of itself, because it is pain, but because occasionally circumstances occur in which toil and pain can procure him some great pleasure. To take a trivial example, which of us ever undertakes laborious physical exercise, except to obtain some advantage from it? But who has any right to find fault with a man who chooses to enjoy a pleasure that has no annoying consequences, or one who avoids a pain that produces no resultant pleasure?"

‎t/files/lorem_ipsum.txt.zst‎

1.18 KB
Binary file not shown.

‎t/files/lorem_ipsum.txt.zst.b64‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
KLUv/QBYnCUAylzEDSMwT5M2aLa7+3tLAlbpt5uID1xhy0abYUBaMxb+GfgGDqqywM0A0gDWALe0
2+
OZexMibPeHtt48XMQ4IrtLlOa3kh1HiuazTjbakROnPbtfMhe9y4eGmUj+OdT+2gKaaL6fFu2no3
3+
7vpeI7iCqx15MqU0L/uDfTnu3x5+L00qhPqYx8Vn1B7sp5U38XvteJLq0B5Ph5d+6unQzhSuqHYc
4+
qhc2Kt3YbpqLQuc+Y587Z/CuuSTjn0zbZ8/zY/uED9kbeGZvuVPXZmNji2mesKU6314T5bkEArEB
5+
AhRYuCl8M3j7Y9tPrFG7tTz1LgyeTLPBj9bB4r0pEwL7ZGy6ad/TZux2cNf5Tp67UG3Z2rp2PKXa
6+
5TLZgytyUebQ8mDF5s6t+B634rLFk43xKUbrt9WOs33VHjdNRnvgPRG6L+pW7Xjtcrd2lKkt9WT6
7+
VJz85HShWzvSMda2MfWkat/mwhvvfQ9T3g7297jO3LJqy7l/TEICgTjQ8AIEjvdUM3fgkcXRmE8h
8+
TxKpNVE5ONtTa2I2fHtxeApuJ3FGXsAARYAFxYIxCYiEIvXazz0d1vkQynTGVls7rzPHYOSvHa8F
9+
tcHeJ4x2LnU5Jp6L6wTGKpjeMJ8Prtg1vGUp5ViplYOuFwDUeCslCreymmaZNraBp5gyPqpmUwc7
10+
lwdLkvFGlpFn7DSmbmxoscc1jtBBzgA1F9+CHK+WN/D2SpcfrJv2lqEFO9HOGfmyc0dzKN5L31P4
11+
CNUhqbwz8uTj1XY6g3M3JBCIVIqDqQhXLHhkcbRYyiewYGABkWDYbEdqS7StjtdQpqNTDu14v3aY
12+
9j21HdnjCcIZtO8kqTbvljPb+z3NRdM8WarSVKnuZPr2pcZjYsJrT9WOVM3l1g57cAVjn1nDXzss
13+
iAQDFqNeUzN9Updq4EUSsZ74LaUeyQpom6kYrPS6wgc5oy7GDx5DaZw+gvUthbvhDHxPqYxboxjr
14+
ccqe2J5RM7cRZfn2mkOxqj3s22dkYmhJ9WBHdY9Tft0cip8Trki5T6fctE0ZdMlXzCmQNiaLN7XR
15+
M1vGJF4x8njFi3zy1/TWjubXHokwI6bw945XjbrmgytQMyLIkik/2E3rXAp/zaCpoT2CUFmv9vJk
16+
SKLDOfF5ngrktqkw9+LJne+2XcYWTxjIlm/P5aOu+WTN4dDeebIcf6ihIIQMMgohMxPIUECStA0g
17+
QmKQUsgHEZQtg4hE05JCaRkDMLtE1l/ABKhDCgtvowneVt6ZeZ+XotmxuIWkC+qPVR9M583bCOsB
18+
7THBuTRE0MtcyafVQzXrhPcN6dr5ttzFQ6N5X8i0n4YfK7h7yRO3oFMAuyAybha6xDBY8YZJcEdq
19+
dygRwlk0TTmcpMlh/TP3aIz9NIvEx7nPn7anFkMPovombPXhOIPwkMIxQcjn5U14SWLYPSjwgeF5
20+
9+j/MIhCavNMJhdGuq6mJ3Qonpe2/WynN7SA0l3FW6DdfITxAJMOxod1OqtldeimsZLIFmq53wMj
21+
fheeNAP4rW8RSQXW6a8ufvg+ElVcppzpxMeRAi7j1wDHPGNnyWAorgmAHeNqY7bcOt/goQKl+FNk
22+
IIrbirHSJaV5AaGXb55/

‎t/message-zstd.t‎

Lines changed: 98 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
#! perl
2+
3+
use strict;
4+
use warnings;
5+
6+
use English qw( -no_match_vars );
7+
8+
use Test::More;
9+
use Test::Needs 'IO::Compress::Zstd';
10+
use Path::Tiny qw( path );
11+
12+
require HTTP::Message;
13+
14+
my $files = path($PROGRAM_NAME)->parent->child('files');
15+
my $lorem_ipsum_clear = $files->child('lorem_ipsum.txt')->slurp_utf8;
16+
my $lorem_ipsum_zstd = $files->child('lorem_ipsum.txt.zst')->slurp_raw;
17+
# my $lorem_ipsum_zstd = $files->child('lorem_ipsum.txt.zst.from_perl')->slurp_raw;
18+
my $lorem_ipsum_zstd_b64 = $files->child('lorem_ipsum.txt.zst.b64')->slurp_raw;
19+
20+
subtest "no decoding" => sub {
21+
22+
my $m = HTTP::Message->new(
23+
[
24+
"Content-Type" => "text/plain",
25+
"Content-Encoding" => "",
26+
],
27+
$lorem_ipsum_clear
28+
);
29+
is( $m->decoded_content, $lorem_ipsum_clear, "decoded_content() works, is same as content" );
30+
ok( $m->decode, "decode() works" );
31+
is( $m->content, $lorem_ipsum_clear, "... and content() is correct" );
32+
};
33+
34+
subtest "decoding zstd" => sub {
35+
36+
my $m = HTTP::Message->new(
37+
[
38+
"Content-Type" => "text/plain",
39+
"Content-Encoding" => "zstd",
40+
],
41+
$lorem_ipsum_zstd
42+
);
43+
is( $m->decoded_content, $lorem_ipsum_clear, "decoded_content() works" );
44+
ok( $m->decode, "decode() works" );
45+
is( $m->content, $lorem_ipsum_clear, "... and content() is correct" );
46+
};
47+
48+
subtest "decoding zstd in base64" => sub {
49+
50+
my $m = HTTP::Message->new(
51+
[
52+
"Content-Type" => "text/plain",
53+
"Content-Encoding" => "zstd, base64",
54+
],
55+
$lorem_ipsum_zstd_b64
56+
);
57+
is( $m->decoded_content, $lorem_ipsum_clear, "decoded_content() works" );
58+
ok( $m->decode, "decode() works" );
59+
is( $m->content, $lorem_ipsum_clear, "... and content() is correct" );
60+
};
61+
62+
subtest "encoding to zstd" => sub {
63+
my $m = HTTP::Message->new(
64+
[
65+
"Content-Type" => "text/plain",
66+
],
67+
$lorem_ipsum_clear
68+
);
69+
is( $m->content, $lorem_ipsum_clear, "the content is the original" );
70+
ok( $m->encode("zstd"), "set encoding to 'zstd'" );
71+
is( $m->header("Content-Encoding"),
72+
"zstd", "... and Content-Encoding is set" );
73+
isnt( $m->content, $lorem_ipsum_clear, "... and the content has changed" );
74+
is( $m->content, $lorem_ipsum_zstd, "... and the content is correct" );
75+
is( $m->decoded_content, $lorem_ipsum_clear, "decoded_content() works" );
76+
ok( $m->decode, "decode() works" );
77+
is( $m->content, $lorem_ipsum_clear, "... and content() is correct" );
78+
};
79+
80+
subtest "encoding to zstd in base64" => sub {
81+
my $m = HTTP::Message->new(
82+
[
83+
"Content-Type" => "text/plain",
84+
],
85+
$lorem_ipsum_clear
86+
);
87+
is( $m->content, $lorem_ipsum_clear, "the content is the original" );
88+
ok( $m->encode("zstd", "base64"), "set encoding to 'zstd' in 'base64'" );
89+
is( $m->header("Content-Encoding"),
90+
"zstd, base64", "... and Content-Encoding is set" );
91+
isnt( $m->content, $lorem_ipsum_clear, "... and the content has changed" );
92+
is( $m->content, $lorem_ipsum_zstd_b64, "... and the content is correct" );
93+
is( $m->decoded_content, $lorem_ipsum_clear, "decoded_content() works" );
94+
ok( $m->decode, "decode() works" );
95+
is( $m->content, $lorem_ipsum_clear, "... and content() is correct" );
96+
};
97+
98+
done_testing;

0 commit comments

Comments
 (0)