Commit | Line | Data |
---|---|---|
ee0007ab LW |
1 | # &open2: tom christiansen, <tchrist@convex.com> |
2 | # | |
3 | # usage: $pid = &open2('rdr', 'wtr', 'some cmd and args'); | |
4 | # or $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args'); | |
5 | # | |
6 | # spawn the given $cmd and connect $rdr for | |
7 | # reading and $wtr for writing. return pid | |
8 | # of child, or 0 on failure. | |
9 | # | |
10 | # WARNING: this is dangerous, as you may block forever | |
11 | # unless you are very careful. | |
12 | # | |
13 | # $wtr is left unbuffered. | |
14 | # | |
15 | # abort program if | |
16 | # rdr or wtr are null | |
17 | # pipe or fork or exec fails | |
18 | ||
19 | package open2; | |
20 | $fh = 'FHOPEN000'; # package static in case called more than once | |
21 | ||
22 | sub main'open2 { | |
23 | local($kidpid); | |
24 | local($dad_rdr, $dad_wtr, @cmd) = @_; | |
25 | ||
26 | $dad_rdr ne '' || die "open2: rdr should not be null"; | |
27 | $dad_wtr ne '' || die "open2: wtr should not be null"; | |
28 | ||
29 | # force unqualified filehandles into callers' package | |
30 | local($package) = caller; | |
31 | $dad_rdr =~ s/^[^']+$/$package'$&/; | |
32 | $dad_wtr =~ s/^[^']+$/$package'$&/; | |
33 | ||
34 | local($kid_rdr) = ++$fh; | |
35 | local($kid_wtr) = ++$fh; | |
36 | ||
37 | pipe($dad_rdr, $kid_wtr) || die "open2: pipe 1 failed: $!"; | |
38 | pipe($kid_rdr, $dad_wtr) || die "open2: pipe 2 failed: $!"; | |
39 | ||
40 | if (($kidpid = fork) < 0) { | |
41 | die "open2: fork failed: $!"; | |
42 | } elsif ($kidpid == 0) { | |
43 | close $dad_rdr; close $dad_wtr; | |
44 | open(STDIN, "<&$kid_rdr"); | |
45 | open(STDOUT, ">&$kid_wtr"); | |
46 | warn "execing @cmd\n" if $debug; | |
47 | exec @cmd; | |
48 | die "open2: exec of @cmd failed"; | |
49 | } | |
50 | close $kid_rdr; close $kid_wtr; | |
51 | select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe | |
52 | $kidpid; | |
53 | } | |
54 | 1; # so require is happy |