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 my $exited = 0;
  17 $SIG{"CHLD"} = sub {
  18         $exited = 1;
  19 };
  20
  21 # write data
  22 my $pid = open(my $out, "|-", @command);
  23 {
  24         # disable buffering at $out
  25         my $old_selected = select;
  26         select $out;
  27         $| = 1;
  28         select $old_selected;
  29 }
  30 print $out $body_data or die "Cannot write data: $!";
  31
  32 sleep 60; # is interrupted by SIGCHLD
  33 if (!$exited) {
  34         close($out);
  35         die "Command did not exit after reading whole body";
  36 }