generate API subs dynamically; refactor open() calls
David Golden
15 years ago
| 14 | 14 | our $VERSION = '0.03'; |
| 15 | 15 | $VERSION = eval $VERSION; ## no critic |
| 16 | 16 | our @ISA = qw/Exporter/; |
| 17 | our @EXPORT_OK = qw/capture tee/; | |
| 17 | our @EXPORT_OK = qw/capture capture_merged tee tee_merged/; | |
| 18 | 18 | |
| 19 | 19 | my $use_system = $^O eq 'MSWin32'; |
| 20 | 20 | |
| 21 | 21 | #--------------------------------------------------------------------------# |
| 22 | # Error messages | |
| 23 | #--------------------------------------------------------------------------# | |
| 24 | ||
| 25 | sub _redirect_err { return "Error redirecting $_[0]: $!" } | |
| 26 | ||
| 27 | #--------------------------------------------------------------------------# | |
| 28 | # bulk filehandle manipulation | |
| 29 | #--------------------------------------------------------------------------# | |
| 22 | # filehandle manipulation | |
| 23 | #--------------------------------------------------------------------------# | |
| 24 | ||
| 25 | sub _open { | |
| 26 | open $_[0], $_[1] or die "Error from open( " . join(q{, }, @_) . "): $!"; | |
| 27 | } | |
| 30 | 28 | |
| 31 | 29 | sub _copy_std { |
| 32 | 30 | my @std = map { IO::Handle->new } 0 .. 2; |
| 33 | open $std[0], "<&STDIN" or die _redirect_err("STDIN" ); | |
| 34 | open $std[1], ">&STDOUT" or die _redirect_err("STDOUT"); | |
| 35 | open $std[2], ">&STDERR" or die _redirect_err("STDERR"); | |
| 31 | _open $std[0], "<&STDIN"; | |
| 32 | _open $std[1], ">&STDOUT"; | |
| 33 | _open $std[2], ">&STDERR"; | |
| 36 | 34 | return @std; |
| 37 | 35 | } |
| 38 | 36 | |
| 39 | 37 | sub _open_std { |
| 40 | open STDIN , "<&" . fileno( $_[0] ) or die _redirect_err("STDIN" ); | |
| 41 | open STDOUT, ">&" . fileno( $_[1] ) or die _redirect_err("STDOUT"); | |
| 42 | open STDERR, ">&" . fileno( $_[2] ) or die _redirect_err("STDERR"); | |
| 38 | _open \*STDIN , "<&" . fileno( $_[0] ); | |
| 39 | _open \*STDOUT, ">&" . fileno( $_[1] ); | |
| 40 | _open \*STDERR, ">&" . fileno( $_[2] ); | |
| 43 | 41 | } |
| 44 | 42 | |
| 45 | 43 | sub _autoflush { |
| 84 | 82 | #--------------------------------------------------------------------------# |
| 85 | 83 | |
| 86 | 84 | sub _capture_tee { |
| 87 | my ($code, $tee) = @_; | |
| 85 | my ($tee, $merge, $code) = @_; | |
| 88 | 86 | |
| 89 | 87 | my @copy_of_std = _copy_std(); |
| 90 | 88 | my @captures = ( undef, scalar tempfile(), scalar tempfile() ); |
| 91 | 89 | my @readers = ( undef, IO::Handle->new, IO::Handle->new ); |
| 92 | 90 | my @tees = ( undef, IO::Handle->new, IO::Handle->new ); |
| 93 | 91 | my @pids; |
| 92 | ||
| 93 | # if merging, redirect STDERR to STDOUT (and don't capture on STDERR) | |
| 94 | # _open if ($merge) { | |
| 94 | 95 | |
| 95 | 96 | # if teeing, redirect output to teeing subprocesses |
| 96 | 97 | if ($tee) { |
| 146 | 147 | } |
| 147 | 148 | |
| 148 | 149 | #--------------------------------------------------------------------------# |
| 149 | # capture() | |
| 150 | #--------------------------------------------------------------------------# | |
| 151 | ||
| 152 | sub capture(&) { ## no critic | |
| 153 | $_[1] = 0; # no tee | |
| 154 | goto \&_capture_tee; | |
| 155 | } | |
| 156 | ||
| 157 | #--------------------------------------------------------------------------# | |
| 158 | # tee() | |
| 159 | #--------------------------------------------------------------------------# | |
| 160 | ||
| 161 | sub tee(&) { ## no critic | |
| 162 | $_[1] = 1; # tee | |
| 163 | goto \&_capture_tee; | |
| 150 | # create API subroutines from [tee flag, merge flag] | |
| 151 | #--------------------------------------------------------------------------# | |
| 152 | ||
| 153 | my %api = ( | |
| 154 | capture => [0,0], | |
| 155 | capture_merged => [0,1], | |
| 156 | tee => [1,0], | |
| 157 | tee_merged => [1,1], | |
| 158 | ); | |
| 159 | ||
| 160 | for my $sub ( keys %api ) { | |
| 161 | my $unshift = join q{, }, @{$api{$sub}}; | |
| 162 | eval "sub $sub (&) { unshift \@_, $unshift; goto \\&_capture_tee; }"; | |
| 164 | 163 | } |
| 165 | 164 | |
| 166 | 165 | 1; |