Codebase list libcapture-tiny-perl / 8c8d4fb
cleaned up code and docs unknown 15 years ago
3 changed file(s) with 39 addition(s) and 54 deletion(s). Raw diff Collapse all Expand all
+1
-1
META.yml less more
1414 Capture::Tiny:
1515 file: lib/Capture/Tiny.pm
1616 version: 0.01
17 generated_by: Module::Build version 0.31012
17 generated_by: Module::Build version 0.3001
1818 meta-spec:
1919 url: http://module-build.sourceforge.net/META-spec-v1.2.html
2020 version: 1.2
+9
-6
README less more
66
77 SYNOPSIS
88 use Capture::Tiny;
9
10 ($stdout, $stderr) = capture {
9
10 ($stdout, $stderr) = capture {
1111 # your code here
1212 };
13
14 ($stdout, $stderr) = tee {
13
14 ($stdout, $stderr) = tee {
1515 # your code here
1616 };
1717
1818 DESCRIPTION
1919 USAGE
2020 capture
21
2122 ($stdout, $stderr) = capture \&code_ref;
2223
2324 tee
25
2426 ($stdout, $stderr) = capture \&code_ref;
2527
2628 BUGS
2729 Please report any bugs or feature using the CPAN Request Tracker. Bugs
2830 can be submitted through the web interface at
29 <http://rt.cpan.org/Dist/Display.html?Queue=Capture-Tiny>
31 http://rt.cpan.org/Dist/Display.html?Queue=Capture-Tiny
3032
3133 When submitting a bug or request, please include a test-file or a patch
3234 to an existing test-file that illustrates the bug or desired feature.
4143 Licensed under Apache License, Version 2.0 (the "License"). You may not
4244 use this file except in compliance with the License. A copy of the
4345 License was distributed with this file or you may obtain a copy of the
44 License from http://www.apache.org/licenses/LICENSE-2.0
46 License from
47 http:E<sol>E<sol>www.apache.orgE<sol>licensesE<sol>LICENSE-2.0
4548
4649 Files produced as output though the use of this software, shall not be
4750 considered Derivative Works, but shall be considered the original work
+29
-47
lib/Capture/Tiny.pm less more
99 use warnings;
1010 use Exporter ();
1111 use File::Temp ();
12 use IO::File;
13 use IO::Handle;
14 use IPC::Open3;
15 use Symbol qw/qualify_to_ref/;
12 use IO::Handle ();
1613 use Fatal qw/pipe open close/;
1714
1815 our $VERSION = '0.01';
4542 }
4643
4744 #--------------------------------------------------------------------------#
48 # _win32_wait_for_start
49 #--------------------------------------------------------------------------#
50
51 sub _win32_wait_for_start {
52 }
53 # my @ ) = @_;
54 ## while (time - $now < 10) {
55 ## my ($out, $err) = _capture_tee(
56 ## sub { print STDOUT "test STDOUT\n"; print STDERR "test STDERR\n" }
57 ## );
58 ## $out ||= 'undef';
59 ## $err ||= 'undef';
60 ### print { $stderr } "Got '$out' and '$err'\n";
61 ## Win32::Sleep( 50 );
62 ## last if ($out eq "test STDOUT\n") && ($err eq "test STDERR\n");
63 ## }
64 # # signal kid process ready to write to STDERR (the capture file)
65 # kill 1, $_ for ($out_kid, $err_kid);
66 # return;
67 #}
68
69 #--------------------------------------------------------------------------#
7045 # _capture_tee()
71 #
72 # kids for tee must always have cloned STD handle on STDOUT and capture
73 # file on STDERR -- on Windows, need to ensure readiness before enabling
74 # tee to capture_file on STDERR. See _win32_wait_for_start
75 #--------------------------------------------------------------------------#
76
77 # command to tee output
46 #--------------------------------------------------------------------------#
47
48 # command to tee output on Win32 -- the argument is a filename that must
49 # be opened to signal that the process is ready to receive input.
50 # This is annoying, but seems to be the best that can be done on Win32
7851 my @cmd = ($^X, '-e',
79 '$SIG{HUP}=sub{exit}; my $f=shift; open my $flag, qq{>$f}; print {$flag} $$; close $flag; ' .
52 '$SIG{HUP}=sub{exit}; my $f=shift; open my $flag, qq{>$f}; ' .
53 'print {$flag} $$; close $flag; ' .
8054 'my $buf; while (sysread(STDIN, $buf, 2048)) { ' .
8155 'syswrite(STDOUT, $buf); syswrite(STDERR, $buf)}'
8256 );
8862
8963 my $stdout_capture = File::Temp::tempfile();
9064 my $stderr_capture = File::Temp::tempfile();
91 # my $stdout_capture = IO::File->new( 'stdout.txt', '+>' );
92 # my $stderr_capture = IO::File->new( 'stderr.txt', '+>' );
9365 my ($stdout_tee, $stdout_reader, $stderr_tee, $stderr_reader) =
9466 map { IO::Handle->new } 1 .. 4;
9567
10274 my @flag_files = map { scalar File::Temp::tmpnam() } 0 .. 1;
10375 # start STDOUT listener
10476 _open_std( $stdout_reader, $copy_of_std[1], $stdout_capture );
105 my $out_kid = system(1, @cmd, $flag_files[0]);
77 push @pids, system(1, @cmd, $flag_files[0]);
10678 push @tees, $stdout_tee;
10779 # start STDERR listener
10880 _open_std( $stderr_reader, $stderr_capture, $copy_of_std[2] );
109 my $err_kid = system(1, @cmd, $flag_files[1]);
110 push @pids, $out_kid, $err_kid;
81 push @pids, system(1, @cmd, $flag_files[1]);
11182 push @tees, $stderr_tee;
83 # redirect our output to the subprocesses
84 _open_std( $copy_of_std[0], $stdout_tee, $stderr_tee );
11285 # wait for the OS get the processes set up
113 _open_std( $copy_of_std[0], $stdout_tee, $stderr_tee );
11486 1 until -f $flag_files[0] && -f $flag_files[1];
11587 unlink $_ for @flag_files;
11688 }
12193 $stdout_reader->close;
12294 $stderr_reader->close;
12395 }
124 # otherwise redirect output to capture file
96 # if not teeing, redirect output to capture file
12597 else {
12698 _open_std( $copy_of_std[0], $stdout_capture, $stderr_capture );
12799 }
128100
129101 # run code block
130102 $code->();
131
103
132104 # restore original handles
133105 _open_std( @copy_of_std );
134
106
135107 # shut down kids
136108 if ( $tee ) {
137109 close $_ for @tees; # they should stop when input closes
142114 }
143115
144116 # read back capture output
145 my ($got_out, $got_err) = map { seek $_, 0, 0; do {local $/; <$_>} }
146 $stdout_capture, $stderr_capture;
117 my ($got_out, $got_err) =
118 map { seek $_,0,0; do {local $/; <$_>} } $stdout_capture, $stderr_capture;
147119
148120 return wantarray ? ($got_out, $got_err) : $got_out;
149121 }
174146
175147 = NAME
176148
177 Capture::Tiny - Capture STDOUT and STDERR from perl, XS or system commands
149 Capture::Tiny - Capture STDOUT and STDERR from perl, XS or external programs
178150
179151 = VERSION
180152
194166
195167 = DESCRIPTION
196168
169 Capture::Tiny provides a simple, portable way to capture anything sent to
170 STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or
171 from an external program. Optionally, output can be teed so that it is
172 captured while being passed through to the original handlers.
197173
198174 = USAGE
199175
203179
204180 == tee
205181
206 ($stdout, $stderr) = capture \&code_ref;
182 ($stdout, $stderr) = tee \&code_ref;
207183
208184 = BUGS
209185
216192
217193 = SEE ALSO
218194
195 * [IO::CaptureOutput]
196 * [IPC::Cmd]
197 * [IPC::Open2]
198 * [IPC::Open3]
199 * [IPC::Run]
200 * [IPC::Run3]
219201
220202 = AUTHOR
221203