third_party/WebKit/LayoutTests/http/tests/misc/resources/slow-png-load.pl

   1 #!/usr/bin/perl -wT
   2
   3 use strict;
   4
   5 use CGI;
   6 use File::stat;
   7
   8 use constant CHUNK_SIZE_BYTES => 256;
   9
  10 my $query = new CGI;
  11 my $filename = $query->param('name');
  12 my $filesize = stat($filename)->size;
  13 my $loadtime = $query->param('loadtime'); # in seconds
  14 my $chunkcount = $filesize / CHUNK_SIZE_BYTES;
  15 my $chunkdelay = $loadtime / $chunkcount;
  16
  17 # flush the buffers after each print
  18 select (STDOUT);
  19 $| = 1;
  20
  21 print "Content-Type: image/png\r\n";
  22 print "Expires: Thu, 01 Dec 2003 16:00:00 GMT\r\n";
  23 print "Cache-Control: no-store, no-cache, must-revalidate\r\n";
  24 print "Pragma: no-cache\r\n";
  25 print "\r\n";
  26
  27 open(FILE, $filename) or die;
  28 binmode FILE;
  29 my ($data, $n);
  30 my $total = 0;
  31
  32 while (($n = read FILE, $data, CHUNK_SIZE_BYTES) != 0) {
  33     print $data;
  34
  35     $total += $n;
  36     if ($total >= $filesize) {
  37         last;
  38     }
  39
  40     # Throttle if there is some.
  41     if ($chunkdelay > 0) {
  42         select(undef, undef, undef, $chunkdelay);
  43     }
  44 }
  45 close(FILE);