1use warnings; 2use strict; 3 4use Config; 5BEGIN { 6 # open2/3 supported on win32, but not Borland due to CRT bugs 7 if(!$Config{d_fork} && 8 (($^O ne 'MSWin32' && $^O ne 'NetWare') || 9 $Config{cc} =~ /^bcc/i)) { 10 require Test::More; 11 Test::More->import(skip_all => 12 "open2/3 not available with MSWin32+Netware+cc=bcc"); 13 } 14} 15 16BEGIN { 17 # make warnings fatal 18 $SIG{__WARN__} = sub { die @_ }; 19} 20 21use IO::Handle; 22use Test::More tests => 23; 23 24require_ok "open3.pl"; 25 26sub cmd_line { 27 if ($^O eq 'MSWin32' || $^O eq 'NetWare') { 28 my $cmd = shift; 29 $cmd =~ tr/\r\n//d; 30 $cmd =~ s/"/\\"/g; 31 return qq/"$cmd"/; 32 } 33 else { 34 return $_[0]; 35 } 36} 37 38my ($pid, $reaped_pid); 39STDOUT->autoflush; 40STDERR->autoflush; 41 42# basic 43$pid = &open3('WRITE', 'READ', 'ERROR', $^X, '-e', cmd_line(<<'EOF')); 44 $| = 1; 45 print scalar <STDIN>; 46 print STDERR "hi error\n"; 47EOF 48ok $pid; 49print WRITE "hi kid\n"; 50like scalar(<READ>), qr/\Ahi kid\r?\n\z/; 51like scalar(<ERROR>), qr/\Ahi error\r?\n\z/; 52ok close(WRITE); 53ok close(READ); 54ok close(ERROR); 55$reaped_pid = waitpid $pid, 0; 56is $reaped_pid, $pid; 57is $?, 0; 58 59# read and error together, both named 60$pid = &open3('WRITE', 'READ', 'READ', $^X, '-e', cmd_line(<<'EOF')); 61 $| = 1; 62 print scalar <STDIN>; 63 print STDERR scalar <STDIN>; 64EOF 65print WRITE "wibble\n"; 66like scalar(<READ>), qr/\Awibble\r?\n\z/; 67print WRITE "wobble\n"; 68like scalar(<READ>), qr/\Awobble\r?\n\z/; 69waitpid $pid, 0; 70 71# read and error together, error empty 72$pid = &open3('WRITE', 'READ', '', $^X, '-e', cmd_line(<<'EOF')); 73 $| = 1; 74 print scalar <STDIN>; 75 print STDERR scalar <STDIN>; 76EOF 77print WRITE "wibble\n"; 78like scalar(<READ>), qr/\Awibble\r?\n\z/; 79print WRITE "wobble\n"; 80like scalar(<READ>), qr/\Awobble\r?\n\z/; 81waitpid $pid, 0; 82 83# dup writer 84ok pipe(PIPE_READ, PIPE_WRITE); 85$pid = &open3('<&PIPE_READ', 'READ', '', $^X, '-e', 'print scalar <STDIN>'); 86close PIPE_READ; 87print PIPE_WRITE "wibble\n"; 88close PIPE_WRITE; 89like scalar(<READ>), qr/\Awibble\r?\n\z/; 90waitpid $pid, 0; 91 92# dup reader 93$pid = &open3('WRITE', 'READ', 'ERROR', $^X, '-e', cmd_line(<<'EOF')); 94 $| = 1; 95 sub cmd_line { 96 $^O eq 'MSWin32' || $^O eq 'NetWare' ? qq/"$_[0]"/ : $_[0]; 97 } 98 require "open3.pl"; 99 $pid = &open3('WRITE', '>&STDOUT', 'ERROR', $^X, '-e', 100 cmd_line('print scalar <STDIN>')); 101 print WRITE "wibble\n"; 102 waitpid $pid, 0; 103EOF 104like scalar(<READ>), qr/\Awibble\r?\n\z/; 105waitpid $pid, 0; 106 107# dup error: This particular case, duping stderr onto the existing 108# stdout but putting stdout somewhere else, is a good case because it 109# used not to work. 110$pid = &open3('WRITE', 'READ', 'ERROR', $^X, '-e', cmd_line(<<'EOF')); 111 $| = 1; 112 sub cmd_line { 113 $^O eq 'MSWin32' || $^O eq 'NetWare' ? qq/"$_[0]"/ : $_[0]; 114 } 115 require "open3.pl"; 116 $pid = &open3('WRITE', 'READ', '>&STDOUT', $^X, '-e', 117 cmd_line('print STDERR scalar <STDIN>')); 118 print WRITE "wibble\n"; 119 waitpid $pid, 0; 120EOF 121like scalar(<READ>), qr/\Awibble\r?\n\z/; 122waitpid $pid, 0; 123 124# dup reader and error together, both named 125$pid = &open3('WRITE', 'READ', 'ERROR', $^X, '-e', cmd_line(<<'EOF')); 126 $| = 1; 127 sub cmd_line { 128 $^O eq 'MSWin32' || $^O eq 'NetWare' ? qq/"$_[0]"/ : $_[0]; 129 } 130 require "open3.pl"; 131 $pid = &open3('WRITE', '>&STDOUT', '>&STDOUT', $^X, '-e', 132 cmd_line('$|=1; print STDOUT scalar <STDIN>; print STDERR scalar <STDIN>')); 133 print WRITE "wibble\n"; 134 print WRITE "wobble\n"; 135 waitpid $pid, 0; 136EOF 137like scalar(<READ>), qr/\Awibble\r?\n\z/; 138like scalar(<READ>), qr/\Awobble\r?\n\z/; 139waitpid $pid, 0; 140 141# dup reader and error together, error empty 142$pid = &open3('WRITE', 'READ', 'ERROR', $^X, '-e', cmd_line(<<'EOF')); 143 $| = 1; 144 sub cmd_line { 145 $^O eq 'MSWin32' || $^O eq 'NetWare' ? qq/"$_[0]"/ : $_[0]; 146 } 147 require "open3.pl"; 148 $pid = &open3('WRITE', '>&STDOUT', '', $^X, '-e', 149 cmd_line('$|=1; print STDOUT scalar <STDIN>; print STDERR scalar <STDIN>')); 150 print WRITE "wibble\n"; 151 print WRITE "wobble\n"; 152 waitpid $pid, 0; 153EOF 154like scalar(<READ>), qr/\Awibble\r?\n\z/; 155like scalar(<READ>), qr/\Awobble\r?\n\z/; 156waitpid $pid, 0; 157 158# command line in single parameter variant of open3 159# for understanding of Config{'sh'} test see exec description in camel book 160my $cmd = 'print(scalar(<STDIN>))'; 161$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd); 162eval{$pid = &open3('WRITE', 'READ', 'ERROR', "$^X -e " . $cmd); }; 163is $@, ""; 164print WRITE "wibble\n"; 165like scalar(<READ>), qr/\Awibble\r?\n\z/; 166waitpid $pid, 0; 167 1681; 169