t/t5562/invoke-with-content-length.pl

   1 use 5.008;
   2 use strict;
   3 use warnings;
   4
   5 my $body_filename = $ARGV[0];
   6 my @command = @ARGV[1 .. $#ARGV];
   7
   8 # read data
   9 my $body_size = -s $body_filename;
  10 $ENV{"CONTENT_LENGTH"} = $body_size;
  11 open(my $body_fh, "<", $body_filename) or die "Cannot open $body_filename: $!";
  12 my $body_data;
  13 defined read($body_fh, $body_data, $body_size) or die "Cannot read $body_filename: $!";
  14 close($body_fh);
  15
  16 # write data
  17 my $pid = open(my $out, "|-", @command);
  18 {
  19         # disable buffering at $out
  20         my $old_selected = select;
  21         select $out;
  22         $| = 1;
  23         select $old_selected;
  24 }
  25 print $out $body_data or die "Cannot write data: $!";
  26
  27 $SIG{ALRM} = sub {
  28         kill 'KILL', $pid;
  29         die "Command did not exit after reading whole body";
  30 };
  31 alarm 60;
  32
  33 my $ret = waitpid($pid, 0);
  34 if ($ret != $pid) {
  35         die "confusing return from waitpid: $ret";
  36 }