view release on metacpan or  search on metacpan

xt/43-response-compression.t  view on Meta::CPAN

    is $res->content, $ondisk, 'the body is the file, byte for byte';
  };

  subtest 'alreadyCompressedType__clientAcceptsGzip__isNotCompressedAgain' => sub {
    my $res = $cb->(GET $PNG, 'Accept-Encoding' => 'gzip');
    is $res->code, 200, 'the image is served';
    is $res->header('Content-Encoding'), undef,
      'an image is left alone: it is already compressed, so gzip is pure cost';
  };

  # The regex in the Expires middleware named application/javascript, while
  # Plack::MIME serves .js as text/javascript, so every JavaScript file went
  # out with no cache header at all. That is the larger half of the page
  # payload by bytes. Guard both halves of the pair.
  subtest 'staticAsset__anyCacheableType__carriesAnExpiresHeader' => sub {
    for my $u ($JS, '/css/netdisco.css', $PNG) {
      my $res = $cb->(GET $u);
      ok $res->header('Expires'), "$u carries an Expires header";
    }
  };
};

# The middleware list is built once, when the app is loaded, so the setting
# cannot be flipped inside the process above. Drive a second interpreter with
# the override that #1592 added, and assert the operator's off switch really
# reaches the middleware list rather than merely existing in the config.
subtest 'compressResponses__settingIsFalse__nothingIsCompressed' => sub {
  my $probe = <<'PROBE';
use Plack::Util; use Plack::Test; use HTTP::Request::Common;
my $app = Plack::Util::load_psgi($ARGV[0]);
test_psgi $app, sub { my $cb = shift;
  my $r = $cb->(GET '/javascripts/portsort.js', 'Accept-Encoding' => 'gzip');
  print 'ENCODING=', ($r->header('Content-Encoding') // 'none'), "\n";
};
PROBE

  # Via a file, not perl -e: the probe contains single quotes, and shell
  # quoting them wrong yields an empty result that looks like a clean pass.
  my $fh = File::Temp->new(SUFFIX => '.pl');
  print {$fh} $probe;
  close $fh;

  local $ENV{NETDISCO_WITH_CONFIGURATION} = '{"compress_responses":false}';
  local $ENV{HARNESS_ACTIVE} = 1;
  my $lib = catdir($FindBin::Bin, updir(), 'lib');
  my $out = qx{$^X -I"$lib" "$fh" "$psgi" 2>/dev/null};

  # Guard against the probe dying and leaving $out empty, which would make the
  # negative assertion below pass for the wrong reason.
  like $out, qr/^ENCODING=/m, 'the probe ran and reported an encoding';

  like $out, qr/^ENCODING=none$/m,
    'with compress_responses false the asset is served uncompressed';
};

# The static assets above cannot produce a text/xml response, and driving one
# needs a populated database, so this is a source assertion. It is here because
# the type was missing from the first version of the list and nothing caught it:
# 87 routes across 18 files are declared with Dancer::Plugin::Ajax's `ajax`
# keyword, which defaults the content type to text/xml rather than text/html,
# and those fragments are the largest responses Netdisco sends. Measured on a
# 7300 port device, one of them is 2,184,560 bytes, compressing to 18,875.
subtest 'compressibleTypes__ajaxFragments__areCoveredByTheList' => sub {
  open my $fh, '<', $psgi or BAIL_OUT("cannot read $psgi: $!");
  my $src = do { local $/; <$fh> };
  my ($list) = $src =~ m/my \@compressible = qw\((.*?)\)/s;
  ok $list, 'the compressible list is where this test expects it';
  like $list, qr{\btext/xml\b},
    'text/xml is listed, or every ajax fragment silently goes uncompressed';
};

done_testing;