]>
Commit | Line | Data |
---|---|---|
d8c44621 PI |
1 | #!/usr/bin/perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use Fcntl; | |
6 | use POSIX ":sys_wait_h"; | |
7 | use IPC::Open3; | |
8 | use IO::Handle; | |
9 | use IO::Select; | |
10 | ||
11 | my $out = shift @ARGV; | |
12 | die unless @ARGV; | |
13 | ||
363d2ccc | 14 | open my $fout, ">>", $out or die "Can't write to $out: $!" if $out; |
d8c44621 PI |
15 | |
16 | my $select = IO::Select->new(); | |
17 | my $alive = 1; | |
18 | my $pid; | |
87d03008 | 19 | my $interactive = -t STDOUT; |
d8c44621 PI |
20 | |
21 | my $code; | |
22 | sub sigchld | |
23 | { | |
24 | my $kid; | |
25 | do { | |
26 | $kid = waitpid( -1, WNOHANG ); | |
27 | if ( $kid == $pid ) { | |
28 | $code = $? >> 8; | |
29 | $alive = 0 | |
30 | } | |
31 | } while ( $kid > 0 ); | |
32 | } | |
33 | $SIG{CHLD} = \&sigchld; | |
34 | ||
1477589b | 35 | $pid = open3( "<&STDIN", \*child_out, \*child_err, @ARGV ); |
d8c44621 PI |
36 | |
37 | sub sethandle | |
38 | { | |
39 | my $h = shift; | |
40 | my $flags = 0; | |
41 | ||
42 | fcntl ( $h, F_GETFL, $flags ) | |
43 | or die "Couldn't get flags for HANDLE : $!\n"; | |
44 | $flags |= O_NONBLOCK; | |
45 | fcntl ( $h, F_SETFL, $flags ) | |
46 | or die "Couldn't set flags for HANDLE: $!\n"; | |
9db5cbe8 | 47 | |
d8c44621 PI |
48 | $select->add( $h ); |
49 | } | |
50 | ||
51 | sethandle( \*child_out ); | |
52 | sethandle( \*child_err ); | |
53 | ||
54 | while ( $alive ) { | |
55 | foreach my $h ( $select->can_read() ) { | |
1c74f9db | 56 | sysread $h, $_, 102400; |
9db5cbe8 | 57 | print $fout $_ if $fout; |
6cf543c0 | 58 | if ( $interactive && $h == \*child_err ) { |
d8c44621 PI |
59 | print "\033[31m$_\033[0m"; |
60 | } else { | |
61 | print $_; | |
62 | } | |
63 | STDOUT->flush(); | |
64 | } | |
65 | } | |
66 | ||
67 | exit $code; |