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

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