--- /dev/null
+## HOW TO CONTRIBUTE
+
+Thank you for considering contributing to this distribution. This file
+contains instructions that will help you work with the source code.
+
+The distribution is managed with Dist::Zilla. This means than many of the
+usual files you might expect are not in the repository, but are generated at
+release time, as is much of the documentation. Some generated files are
+kept in the repository as a convenience (e.g. Makefile.PL or cpanfile).
+
+Generally, **you do not need Dist::Zilla to contribute patches**. You do need
+Dist::Zilla to create a tarball. See below for guidance.
+
+### Getting dependencies
+
+If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to
+satisfy dependencies like this:
+
+ $ cpanm --installdeps .
+
+Otherwise, look for either a `Makefile.PL` or `cpanfile` file for
+a list of dependencies to satisfy.
+
+### Running tests
+
+You can run tests directly using the `prove` tool:
+
+ $ prove -l
+ $ prove -lv t/some_test_file.t
+
+For most of my distributions, `prove` is entirely sufficient for you to test any
+patches you have. I use `prove` for 99% of my testing during development.
+
+### Code style and tidying
+
+Please try to match any existing coding style. If there is a `.perltidyrc`
+file, please install Perl::Tidy and use perltidy before submitting patches.
+
+If there is a `tidyall.ini` file, you can also install Code::TidyAll and run
+`tidyall` on a file or `tidyall -a` to tidy all files.
+
+### Patching documentation
+
+Much of the documentation Pod is generated at release time. Some is
+generated boilerplate; other documentation is built from pseudo-POD
+directives in the source like C<=method> or C<=func>.
+
+If you would like to submit a documentation edit, please limit yourself to
+the documentation you see.
+
+If you see typos or documentation issues in the generated docs, please
+email or open a bug ticket instead of patching.
+
+### Installing and using Dist::Zilla
+
+Dist::Zilla is a very powerful authoring tool, optimized for maintaining a
+large number of distributions with a high degree of automation, but it has a
+large dependency chain, a bit of a learning curve and requires a number of
+author-specific plugins.
+
+To install it from CPAN, I recommend one of the following approaches for
+the quickest installation:
+
+ # using CPAN.pm, but bypassing non-functional pod tests
+ $ cpan TAP::Harness::Restricted
+ $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla
+
+ # using cpanm, bypassing *all* tests
+ $ cpanm -n Dist::Zilla
+
+In either case, it's probably going to take about 10 minutes. Go for a walk,
+go get a cup of your favorite beverage, take a bathroom break, or whatever.
+When you get back, Dist::Zilla should be ready for you.
+
+Then you need to install any plugins specific to this distribution:
+
+ $ cpan `dzil authordeps`
+ $ dzil authordeps | cpanm
+
+Once installed, here are some dzil commands you might try:
+
+ $ dzil build
+ $ dzil test
+ $ dzil xtest
+
+You can learn more about Dist::Zilla at http://dzil.org/
+
--- /dev/null
+Revision history for Capture-Tiny
+
+0.48 2018-04-22 09:01:08+02:00 Europe/Oslo
+
+ - No changes from 0.47-TRIAL
+
+0.47 2017-07-26 10:34:24-04:00 America/New_York (TRIAL RELEASE)
+
+ [Fixed]
+
+ - Appends PID to random file names for tee signalling to avoid
+ random name collision when used in multiple forked children.
+
+0.46 2017-02-25 14:19:22-05:00 America/New_York
+
+ - No changes from 0.45-TRIAL
+
+0.45 2017-02-23 13:22:43-05:00 America/New_York (TRIAL RELEASE)
+
+ [Internal]
+
+ - Avoid variable shadowing to improve debuggability.
+
+0.44 2016-08-05 13:40:33-04:00 America/New_York
+
+ [Docs]
+
+ - Note that dropping privileges during a capture can lead to
+ temporary files not cleaned up.
+
+0.42 2016-05-31 12:40:10-04:00 America/New_York
+
+ - No changes from 0.41
+
+0.41 2016-05-23 11:58:15-04:00 America/New_York (TRIAL RELEASE)
+
+ [Fixed]
+
+ - Fixed some failing tests when STDIN is routed to /dev/null
+
+0.40 2016-05-23 11:42:35-04:00 America/New_York
+
+ - No changes from 0.39
+
+0.39 2016-05-02 10:21:48-04:00 America/New_York (TRIAL RELEASE)
+
+ [Fixed]
+
+ - Fix in 0.37 tickled a very obscure regular expressions bug in perl <
+ 5.18; should now be fixed.
+
+0.37 2016-05-02 07:08:31-04:00 America/New_York (TRIAL RELEASE)
+
+ [Fixed]
+
+ - Skip some tests if locale can't be determined.
+
+0.36 2016-02-28 21:36:57-05:00 America/New_York
+
+ [Docs]
+
+ - Fixed typos.
+
+0.34 2016-02-18 23:26:13-05:00 America/New_York
+
+ [Fixed]
+
+ - Removed spurious JSON::PP dependency added by a broken
+ Dist::Zilla plugin.
+
+0.32 2016-02-18 10:12:02-05:00 America/New_York
+
+ [Docs]
+
+ - Changed internal formatting of documentation
+
+ [Changes]
+
+ - No functional changes from 0.31
+
+0.31 2016-02-14 07:33:50-07:00 America/Mazatlan (TRIAL RELEASE)
+
+ [Fixed]
+
+ - Application of layers to handles during and after capture now attempts
+ to more accurately duplicate the original layers, including potential
+ duplicate layers. Because of the unusual ways that layers are ordered
+ and applied, exact duplication is not guaranteeed, but this should be
+ better that what Capture::Tiny did before.
+
+ - Avoids a hard crash on Windows with Perl < 5.20 if a fork occurs in a
+ capture block. Also documented the risks and lack of support for
+ forks in capture blocks.
+
+0.30 2015-05-15 20:43:54-04:00 America/New_York
+
+ No changes from 0.29
+
+0.29 2015-04-19 18:36:24+02:00 Europe/Berlin (TRIAL RELEASE)
+
+ Fixed:
+
+ - Fix double filehandle close error with tee on Windows
+ (which started warning during the perl 5.21.x series,
+ causing tests to fail)
+
+0.28 2015-02-11 06:39:51-05:00 America/New_York
+
+ Tests:
+
+ - Removes test that optionally uses Inline::C to avoid spurious
+ test failures. Also Inline::C had become a fairly heavy
+ (if optional) dependency.
+
+ Docs:
+
+ - Clarify that PERL_CAPTURE_TINY_TIMEOUT is an internal control,
+ not a timeout of the code reference being captured.
+
+0.27 2014-11-04 23:10:44-05:00 America/New_York
+
+ Prereqs:
+
+ - Make Inline::C recommended, not required
+
+0.26 2014-11-04 06:55:15-05:00 America/New_York
+
+ Tests:
+
+ - Actually check for Inline::C in tests, not just Inline
+
+0.25 2014-08-16 10:08:42-04:00 America/New_York
+
+ Prereqs:
+
+ - Amended recommended modules to list Inline::C rather than Inline
+
+0.24 2014-02-06 17:15:37-05:00 America/New_York
+
+ Fixed:
+
+ - Closed security hole in use of semaphore file in /tmp;
+ now opens the semaphore file using O_CREAT|O_EXCL
+
+0.23 2013-10-20 11:25:34 America/New_York
+
+ Fixed:
+
+ - minimum Perl prereq is back to 5.6 (but $diety help you if
+ you're still stuck on 5.6)
+
+ Documented:
+
+ - Added warning about using @_ in a capture block
+
+0.22 2013-03-27 15:50:29 America/New_York
+
+ Documented:
+
+ - Issue tracker is now github
+
+0.21 2012-11-14 19:04:49 America/New_York
+
+ Changed:
+
+ - Skips tee and leak tests for closed STDIN on Perl prior to
+ 5.12 when PERL_UNICODE=D. Documented lack of support as
+ a known issue.
+
+ - Isolated tee subprocesses from effects of PERL_UNICODE as a
+ precaution (though this did not fix the above issue).
+
+ - Improved layer detection for handles proxied due to being closed
+ or tied.
+
+0.20 2012-09-19 13:20:57 America/New_York
+
+ Fixed:
+
+ - Nested merged captures that include an external program call no longer
+ leak STDERR to the outer scope [rt.cpan.org #79376]
+
+0.19 2012-08-06 20:26:34 America/New_York
+
+ Fixed:
+
+ - Work around rt.perl.org #114404 by forcing PerlIO layers back on
+ original handles [rt.cpan.org #78819]
+
+0.18 2012-05-04 16:31:53 America/New_York
+
+ Added:
+
+ - When capture or tee are called in void context, Capture::Tiny
+ skips reading back from the capture handles if it can do so safely
+
+0.17_52 2012-03-09 11:45:19 EST5EDT
+
+ Fixed:
+
+ - Tied STDIN is always localized before redirections to avoid tees
+ hanging on MSWin32
+
+ - Copying and reopening STDIN is necessary to avoid tees hanging on MSWin32.
+
+0.17_51 2012-03-07 18:22:34 EST5EDT
+
+ Fixed:
+
+ - Avoids reopening STDIN while setting up a capture, which avoids
+ some problems with pathological tied filehandle implementations
+ such as in FCGI
+
+ Tested:
+
+ - Re-enabled tied STDIN testing for MSWin32 to see if changes above
+ avoid crashes seen historically
+
+0.17 2012-02-22 08:07:41 EST5EDT
+
+ Fixed:
+
+ - Added a workaround for failing t/08-stdin-closed.t under blead
+ perl / 5.15.8 [rt.perl.org #111070]
+
+ Documented:
+
+ - Clarified some limitations; added a link to CPAN Testers Matrix;
+ removed redundant BUGS section; standardized terminology
+
+ Tested:
+
+ - Added a test using Inline::C to print to stdout and stderr in response
+ to rt.cpan.org #71701
+
+0.16 2012-02-12 21:04:24 EST5EDT
+
+ Documented:
+
+ - Noted problems and workaround for FCGI's pathological tied STDIN
+ [rt.cpan.org #74681; thank you Karl Gaissmaier for testing the
+ workaround]
+
+0.15 2011-12-23 11:10:47 EST5EDT
+
+ Fixed:
+
+ - Repeated captures from a custom filehandle would return undef instead
+ of the empty string (and would warn). This has been fixed.
+ [rt.cpan.org #73374 part two. Thank you to Philipp Herz for help
+ in reproducing this bug.]
+
+ Other:
+
+ - Commented out debugging code for slightly less runtime overhead
+
+0.14 2011-12-22 10:14:09 EST5EDT
+
+ Added:
+
+ - Capturing with custom filehandles will return only newly appended
+ output instead of everything already in the file.
+ [rt.cpan.org #73374]
+
+0.13 2011-12-02 13:39:00 EST5EDT
+
+ Fixed:
+
+ - Fixed t/18-custom-capture.t failures on Windows due to tempfile
+ removal problems in the testfile
+
+0.12 2011-12-01 16:58:05 EST5EDT
+
+ Added:
+
+ - New functions capture_stdout, capture_stderr, tee_stdout, tee_stderr
+ [rt.cpan.org #60515]
+
+ - Capture functions also returns the return values from the executed
+ coderef [rt.cpan.org #61794, adapted from patch by Christian Walde]
+
+ - Capture functions take optional custom filehandles for capturing
+ via named files instead of anonymous ones [inspired by Christian Walde]
+
+ Fixed:
+
+ - Tied filehandles based on Tie::StdHandle can now use the ":utf8"
+ layer; removed remaining TODO tests; adds Scalar::Util as a dependency
+
+ Changed:
+
+ - When Time::HiRes::usleep is available, tee operations will
+ sleep during the busy-loop waiting for tee processes to be ready
+ [rt.cpan.org #67858]
+
+0.11 2011-05-19 23:34:23 America/New_York
+
+ Fixed:
+
+ - Tests will not use Test::Differences version 0.60 or greater
+
+0.10 2011-02-07 07:01:44 EST5EDT
+
+ Fixed:
+
+ - Setting PERL_CAPTURE_TINY_TIMEOUT to 0 will disable timeouts
+
+0.09 2011-01-27 23:52:16 EST5EDT
+
+ Added:
+
+ - Added support for $ENV{PERL_CAPTURE_TINY_TIMEOUT} to control
+ the timeout period under 'tee'; tests set not to timeout to
+ avoid false FAIL reports on overloaded virtual machine smokers
+
+ Fixed:
+
+ - $@ set within a captured block is no longer lost when the capture
+ is completed; likewise, the initial value of $@ is not lost
+ during capture (when no subsequent error occurs) (RT #65139)
+
+0.08 Sun Jun 20 19:13:19 EDT 2010
+
+ Fixed:
+
+ - Exceptions in captured coderef are caught, then handles are restored
+ before the exception is rethrown (RT #58208)
+
+0.07 Sun Jan 24 00:18:45 EST 2010
+
+ Fixed:
+
+ - Changed test for $? preservation to be more portable
+
+ - Dropped support for Perl 5.8.0 specifically due to excessive bugs.
+ Tests will bail out. (5.6.X is still supported)
+
+0.06 Thu May 7 06:54:53 EDT 2009
+
+ Fixed:
+
+ - On Win32, subprocesses now close themselves on EOF instead of being
+ killed with a signal
+
+0.05_51 Tue Apr 21 07:00:38 EDT 2009
+
+ Added:
+
+ - Support for wide characters on handles opened to utf8
+
+ - Support for STDOUT, STDERR or STDIN opened to in-memory
+ files (open to scalar reference) or tied, albeit with some limitations
+
+ Testing:
+
+ - Verify that $? is preserved during capture { system(@cmd) };
+
+0.05 Tue Mar 3 06:56:05 EST 2009
+
+ Fixed:
+
+ - On Win32, increased a delay waiting for buffers to flush to avoid losing
+ final output during tee()
+
+0.04 Wed Feb 25 09:25:27 EST 2009
+
+ Added:
+
+ - Can capture/tee even if STDIN, STDOUT or STDERR are closed prior to
+ capture/tee block
+
+ - Generally, added more error handling
+
+ Fixed:
+
+ - Will timeout instead of hang if subprocesses fail to start
+
+0.03 Fri Feb 20 13:03:08 EST 2009
+
+ Added:
+
+ - capture_merged() and tee_merged()
+
+ Fixed:
+
+ - Tests skip if not Win32 and no fork() (rather than Build.PL and
+ Makefile.PL failing); this allows capture() on odd platforms, even if
+ fork doesn't work
+
+0.02 Tue Feb 17 17:24:35 EST 2009
+
+ Fixed:
+
+ - Bug recovering output when STDOUT is empty (reported by Vincent Pit)
+
+ - Removed Fatal.pm to avoid global action-at-a-distance
+
+0.01 Fri Feb 13 23:15:19 EST 2009
+
+ Added:
+ - 'capture' and 'tee' functions
+
+# vim: set ts=2 sts=2 sw=2 et tw=75:
--- /dev/null
+This software is Copyright (c) 2009 by David Golden.
+
+This is free software, licensed under:
+
+ The Apache License, Version 2.0, January 2004
+
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+ 6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+ 7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+ 8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+ 9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+ END OF TERMS AND CONDITIONS
+
+ APPENDIX: How to apply the Apache License to your work.
+
+ To apply the Apache License to your work, attach the following
+ boilerplate notice, with the fields enclosed by brackets "[]"
+ replaced with your own identifying information. (Don't include
+ the brackets!) The text should be enclosed in the appropriate
+ comment syntax for the file format. We also recommend that a
+ file or class name and description of purpose be included on the
+ same "printed page" as the copyright notice for easier
+ identification within third-party archives.
+
+ Copyright [yyyy] [name of copyright owner]
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
--- /dev/null
+# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012.
+CONTRIBUTING.mkdn
+Changes
+LICENSE
+MANIFEST
+META.json
+META.yml
+Makefile.PL
+README
+Todo
+cpanfile
+dist.ini
+examples/rt-58208.pl
+examples/tee.pl
+lib/Capture/Tiny.pm
+perlcritic.rc
+t/00-report-prereqs.dd
+t/00-report-prereqs.t
+t/01-Capture-Tiny.t
+t/02-capture.t
+t/03-tee.t
+t/06-stdout-closed.t
+t/07-stderr-closed.t
+t/08-stdin-closed.t
+t/09-preserve-exit-code.t
+t/10-stdout-string.t
+t/11-stderr-string.t
+t/12-stdin-string.t
+t/13-stdout-tied.t
+t/14-stderr-tied.t
+t/15-stdin-tied.t
+t/16-catch-errors.t
+t/17-pass-results.t
+t/18-custom-capture.t
+t/19-relayering.t
+t/20-stdout-badtie.t
+t/21-stderr-badtie.t
+t/22-stdin-badtie.t
+t/23-all-tied.t
+t/24-all-badtied.t
+t/25-cap-fork.t
+t/lib/Cases.pm
+t/lib/TieEvil.pm
+t/lib/TieLC.pm
+t/lib/Utils.pm
+xt/author/00-compile.t
+xt/author/critic.t
+xt/author/minimum-version.t
+xt/author/pod-coverage.t
+xt/author/pod-spell.t
+xt/author/pod-syntax.t
+xt/author/portability.t
+xt/author/test-version.t
+xt/release/distmeta.t
--- /dev/null
+{
+ "abstract" : "Capture STDOUT and STDERR from Perl, XS or external programs",
+ "author" : [
+ "David Golden <dagolden@cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010",
+ "license" : [
+ "apache_2_0"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : 2
+ },
+ "name" : "Capture-Tiny",
+ "no_index" : {
+ "directory" : [
+ "corpus",
+ "examples",
+ "t",
+ "xt"
+ ],
+ "package" : [
+ "DB"
+ ]
+ },
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "6.17"
+ }
+ },
+ "develop" : {
+ "requires" : {
+ "Dist::Zilla" : "5",
+ "Dist::Zilla::Plugin::OSPrereqs" : "0",
+ "Dist::Zilla::Plugin::Prereqs" : "0",
+ "Dist::Zilla::Plugin::ReleaseStatus::FromVersion" : "0",
+ "Dist::Zilla::Plugin::RemovePrereqs" : "0",
+ "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072",
+ "File::Spec" : "0",
+ "File::Temp" : "0",
+ "IO::Handle" : "0",
+ "IPC::Open3" : "0",
+ "Pod::Coverage::TrustPod" : "0",
+ "Pod::Wordlist" : "0",
+ "Software::License::Apache_2_0" : "0",
+ "Test::CPAN::Meta" : "0",
+ "Test::MinimumVersion" : "0",
+ "Test::More" : "0",
+ "Test::Perl::Critic" : "0",
+ "Test::Pod" : "1.41",
+ "Test::Pod::Coverage" : "1.08",
+ "Test::Portability::Files" : "0",
+ "Test::Spelling" : "0.12",
+ "Test::Version" : "1"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Carp" : "0",
+ "Exporter" : "0",
+ "File::Spec" : "0",
+ "File::Temp" : "0",
+ "IO::Handle" : "0",
+ "Scalar::Util" : "0",
+ "perl" : "5.006",
+ "strict" : "0",
+ "warnings" : "0"
+ }
+ },
+ "test" : {
+ "recommends" : {
+ "CPAN::Meta" : "2.120900"
+ },
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0",
+ "File::Spec" : "0",
+ "IO::File" : "0",
+ "Test::More" : "0.62",
+ "lib" : "0"
+ }
+ }
+ },
+ "provides" : {
+ "Capture::Tiny" : {
+ "file" : "lib/Capture/Tiny.pm",
+ "version" : "0.48"
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://github.com/dagolden/Capture-Tiny/issues"
+ },
+ "homepage" : "https://github.com/dagolden/Capture-Tiny",
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/dagolden/Capture-Tiny.git",
+ "web" : "https://github.com/dagolden/Capture-Tiny"
+ }
+ },
+ "version" : "0.48",
+ "x_authority" : "cpan:DAGOLDEN",
+ "x_contributors" : [
+ "Dagfinn Ilmari Manns\u00e5ker <ilmari@ilmari.org>",
+ "David E. Wheeler <david@justatheory.com>",
+ "fecundf <not.com+github@gmail.com>",
+ "Graham Knop <haarg@haarg.org>",
+ "Peter Rabbitson <ribasushi@cpan.org>"
+ ],
+ "x_generated_by_perl" : "v5.26.1",
+ "x_serialization_backend" : "Cpanel::JSON::XS version 3.0239"
+}
+
--- /dev/null
+---
+abstract: 'Capture STDOUT and STDERR from Perl, XS or external programs'
+author:
+ - 'David Golden <dagolden@cpan.org>'
+build_requires:
+ ExtUtils::MakeMaker: '0'
+ File::Spec: '0'
+ IO::File: '0'
+ Test::More: '0.62'
+ lib: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '6.17'
+dynamic_config: 1
+generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010'
+license: apache
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Capture-Tiny
+no_index:
+ directory:
+ - corpus
+ - examples
+ - t
+ - xt
+ package:
+ - DB
+provides:
+ Capture::Tiny:
+ file: lib/Capture/Tiny.pm
+ version: '0.48'
+requires:
+ Carp: '0'
+ Exporter: '0'
+ File::Spec: '0'
+ File::Temp: '0'
+ IO::Handle: '0'
+ Scalar::Util: '0'
+ perl: '5.006'
+ strict: '0'
+ warnings: '0'
+resources:
+ bugtracker: https://github.com/dagolden/Capture-Tiny/issues
+ homepage: https://github.com/dagolden/Capture-Tiny
+ repository: https://github.com/dagolden/Capture-Tiny.git
+version: '0.48'
+x_authority: cpan:DAGOLDEN
+x_contributors:
+ - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
+ - 'David E. Wheeler <david@justatheory.com>'
+ - 'fecundf <not.com+github@gmail.com>'
+ - 'Graham Knop <haarg@haarg.org>'
+ - 'Peter Rabbitson <ribasushi@cpan.org>'
+x_generated_by_perl: v5.26.1
+x_serialization_backend: 'YAML::Tiny version 1.70'
--- /dev/null
+# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012.
+use strict;
+use warnings;
+
+use 5.006;
+
+use ExtUtils::MakeMaker 6.17;
+
+my %WriteMakefileArgs = (
+ "ABSTRACT" => "Capture STDOUT and STDERR from Perl, XS or external programs",
+ "AUTHOR" => "David Golden <dagolden\@cpan.org>",
+ "CONFIGURE_REQUIRES" => {
+ "ExtUtils::MakeMaker" => "6.17"
+ },
+ "DISTNAME" => "Capture-Tiny",
+ "LICENSE" => "apache",
+ "MIN_PERL_VERSION" => "5.006",
+ "NAME" => "Capture::Tiny",
+ "PREREQ_PM" => {
+ "Carp" => 0,
+ "Exporter" => 0,
+ "File::Spec" => 0,
+ "File::Temp" => 0,
+ "IO::Handle" => 0,
+ "Scalar::Util" => 0,
+ "strict" => 0,
+ "warnings" => 0
+ },
+ "TEST_REQUIRES" => {
+ "ExtUtils::MakeMaker" => 0,
+ "File::Spec" => 0,
+ "IO::File" => 0,
+ "Test::More" => "0.62",
+ "lib" => 0
+ },
+ "VERSION" => "0.48",
+ "test" => {
+ "TESTS" => "t/*.t"
+ }
+);
+
+
+my %FallbackPrereqs = (
+ "Carp" => 0,
+ "Exporter" => 0,
+ "ExtUtils::MakeMaker" => 0,
+ "File::Spec" => 0,
+ "File::Temp" => 0,
+ "IO::File" => 0,
+ "IO::Handle" => 0,
+ "Scalar::Util" => 0,
+ "Test::More" => "0.62",
+ "lib" => 0,
+ "strict" => 0,
+ "warnings" => 0
+);
+
+
+unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
+ delete $WriteMakefileArgs{TEST_REQUIRES};
+ delete $WriteMakefileArgs{BUILD_REQUIRES};
+ $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
+}
+
+delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
+ unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
+
+if ( $^O eq 'MSWin32' ) {
+ $WriteMakefileArgs{PREREQ_PM}{'Win32API::File'} = $FallbackPrereqs{'Win32API::File'} = '0';
+}
+
+WriteMakefile(%WriteMakefileArgs);
--- /dev/null
+NAME
+ Capture::Tiny - Capture STDOUT and STDERR from Perl, XS or external
+ programs
+
+VERSION
+ version 0.48
+
+SYNOPSIS
+ use Capture::Tiny ':all';
+
+ # capture from external command
+
+ ($stdout, $stderr, $exit) = capture {
+ system( $cmd, @args );
+ };
+
+ # capture from arbitrary code (Perl or external)
+
+ ($stdout, $stderr, @result) = capture {
+ # your code here
+ };
+
+ # capture partial or merged output
+
+ $stdout = capture_stdout { ... };
+ $stderr = capture_stderr { ... };
+ $merged = capture_merged { ... };
+
+ # tee output
+
+ ($stdout, $stderr) = tee {
+ # your code here
+ };
+
+ $stdout = tee_stdout { ... };
+ $stderr = tee_stderr { ... };
+ $merged = tee_merged { ... };
+
+DESCRIPTION
+ Capture::Tiny provides a simple, portable way to capture almost anything
+ sent to STDOUT or STDERR, regardless of whether it comes from Perl, from
+ XS code or from an external program. Optionally, output can be teed so
+ that it is captured while being passed through to the original
+ filehandles. Yes, it even works on Windows (usually). Stop guessing
+ which of a dozen capturing modules to use in any particular situation
+ and just use this one.
+
+USAGE
+ The following functions are available. None are exported by default.
+
+ capture
+ ($stdout, $stderr, @result) = capture \&code;
+ $stdout = capture \&code;
+
+ The "capture" function takes a code reference and returns what is sent
+ to STDOUT and STDERR as well as any return values from the code
+ reference. In scalar context, it returns only STDOUT. If no output was
+ received for a filehandle, it returns an empty string for that
+ filehandle. Regardless of calling context, all output is captured --
+ nothing is passed to the existing filehandles.
+
+ It is prototyped to take a subroutine reference as an argument. Thus, it
+ can be called in block form:
+
+ ($stdout, $stderr) = capture {
+ # your code here ...
+ };
+
+ Note that the coderef is evaluated in list context. If you wish to force
+ scalar context on the return value, you must use the "scalar" keyword.
+
+ ($stdout, $stderr, $count) = capture {
+ my @list = qw/one two three/;
+ return scalar @list; # $count will be 3
+ };
+
+ Also note that within the coderef, the @_ variable will be empty. So
+ don't use arguments from a surrounding subroutine without copying them
+ to an array first:
+
+ sub wont_work {
+ my ($stdout, $stderr) = capture { do_stuff( @_ ) }; # WRONG
+ ...
+ }
+
+ sub will_work {
+ my @args = @_;
+ my ($stdout, $stderr) = capture { do_stuff( @args ) }; # RIGHT
+ ...
+ }
+
+ Captures are normally done to an anonymous temporary filehandle. To
+ capture via a named file (e.g. to externally monitor a long-running
+ capture), provide custom filehandles as a trailing list of option pairs:
+
+ my $out_fh = IO::File->new("out.txt", "w+");
+ my $err_fh = IO::File->new("out.txt", "w+");
+ capture { ... } stdout => $out_fh, stderr => $err_fh;
+
+ The filehandles must be read/write and seekable. Modifying the files or
+ filehandles during a capture operation will give unpredictable results.
+ Existing IO layers on them may be changed by the capture.
+
+ When called in void context, "capture" saves memory and time by not
+ reading back from the capture handles.
+
+ capture_stdout
+ ($stdout, @result) = capture_stdout \&code;
+ $stdout = capture_stdout \&code;
+
+ The "capture_stdout" function works just like "capture" except only
+ STDOUT is captured. STDERR is not captured.
+
+ capture_stderr
+ ($stderr, @result) = capture_stderr \&code;
+ $stderr = capture_stderr \&code;
+
+ The "capture_stderr" function works just like "capture" except only
+ STDERR is captured. STDOUT is not captured.
+
+ capture_merged
+ ($merged, @result) = capture_merged \&code;
+ $merged = capture_merged \&code;
+
+ The "capture_merged" function works just like "capture" except STDOUT
+ and STDERR are merged. (Technically, STDERR is redirected to the same
+ capturing handle as STDOUT before executing the function.)
+
+ Caution: STDOUT and STDERR output in the merged result are not
+ guaranteed to be properly ordered due to buffering.
+
+ tee
+ ($stdout, $stderr, @result) = tee \&code;
+ $stdout = tee \&code;
+
+ The "tee" function works just like "capture", except that output is
+ captured as well as passed on to the original STDOUT and STDERR.
+
+ When called in void context, "tee" saves memory and time by not reading
+ back from the capture handles, except when the original STDOUT OR STDERR
+ were tied or opened to a scalar handle.
+
+ tee_stdout
+ ($stdout, @result) = tee_stdout \&code;
+ $stdout = tee_stdout \&code;
+
+ The "tee_stdout" function works just like "tee" except only STDOUT is
+ teed. STDERR is not teed (output goes to STDERR as usual).
+
+ tee_stderr
+ ($stderr, @result) = tee_stderr \&code;
+ $stderr = tee_stderr \&code;
+
+ The "tee_stderr" function works just like "tee" except only STDERR is
+ teed. STDOUT is not teed (output goes to STDOUT as usual).
+
+ tee_merged
+ ($merged, @result) = tee_merged \&code;
+ $merged = tee_merged \&code;
+
+ The "tee_merged" function works just like "capture_merged" except that
+ output is captured as well as passed on to STDOUT.
+
+ Caution: STDOUT and STDERR output in the merged result are not
+ guaranteed to be properly ordered due to buffering.
+
+LIMITATIONS
+ Portability
+ Portability is a goal, not a guarantee. "tee" requires fork, except on
+ Windows where "system(1, @cmd)" is used instead. Not tested on any
+ particularly esoteric platforms yet. See the CPAN Testers Matrix
+ <http://matrix.cpantesters.org/?dist=Capture-Tiny> for test result by
+ platform.
+
+ PerlIO layers
+ Capture::Tiny does its best to preserve PerlIO layers such as ':utf8' or
+ ':crlf' when capturing (only for Perl 5.8.1+) . Layers should be applied
+ to STDOUT or STDERR *before* the call to "capture" or "tee". This may
+ not work for tied filehandles (see below).
+
+ Modifying filehandles before capturing
+ Generally speaking, you should do little or no manipulation of the
+ standard IO filehandles prior to using Capture::Tiny. In particular,
+ closing, reopening, localizing or tying standard filehandles prior to
+ capture may cause a variety of unexpected, undesirable and/or unreliable
+ behaviors, as described below. Capture::Tiny does its best to compensate
+ for these situations, but the results may not be what you desire.
+
+ Closed filehandles
+ Capture::Tiny will work even if STDIN, STDOUT or STDERR have been
+ previously closed. However, since they will be reopened to capture or
+ tee output, any code within the captured block that depends on finding
+ them closed will, of course, not find them to be closed. If they started
+ closed, Capture::Tiny will close them again when the capture block
+ finishes.
+
+ Note that this reopening will happen even for STDIN or a filehandle not
+ being captured to ensure that the filehandle used for capture is not
+ opened to file descriptor 0, as this causes problems on various
+ platforms.
+
+ Prior to Perl 5.12, closed STDIN combined with PERL_UNICODE=D leaks
+ filehandles and also breaks tee() for undiagnosed reasons. So don't do
+ that.
+
+ Localized filehandles
+ If code localizes any of Perl's standard filehandles before capturing,
+ the capture will affect the localized filehandles and not the original
+ ones. External system calls are not affected by localizing a filehandle
+ in Perl and will continue to send output to the original filehandles
+ (which will thus not be captured).
+
+ Scalar filehandles
+ If STDOUT or STDERR are reopened to scalar filehandles prior to the call
+ to "capture" or "tee", then Capture::Tiny will override the output
+ filehandle for the duration of the "capture" or "tee" call and then, for
+ "tee", send captured output to the output filehandle after the capture
+ is complete. (Requires Perl 5.8)
+
+ Capture::Tiny attempts to preserve the semantics of STDIN opened to a
+ scalar reference, but note that external processes will not be able to
+ read from such a handle. Capture::Tiny tries to ensure that external
+ processes will read from the null device instead, but this is not
+ guaranteed.
+
+ Tied output filehandles
+ If STDOUT or STDERR are tied prior to the call to "capture" or "tee",
+ then Capture::Tiny will attempt to override the tie for the duration of
+ the "capture" or "tee" call and then send captured output to the tied
+ filehandle after the capture is complete. (Requires Perl 5.8)
+
+ Capture::Tiny may not succeed resending UTF-8 encoded data to a tied
+ STDOUT or STDERR filehandle. Characters may appear as bytes. If the tied
+ filehandle is based on Tie::StdHandle, then Capture::Tiny will attempt
+ to determine appropriate layers like ":utf8" from the underlying
+ filehandle and do the right thing.
+
+ Tied input filehandle
+ Capture::Tiny attempts to preserve the semantics of tied STDIN, but this
+ requires Perl 5.8 and is not entirely predictable. External processes
+ will not be able to read from such a handle.
+
+ Unless having STDIN tied is crucial, it may be safest to localize STDIN
+ when capturing:
+
+ my ($out, $err) = do { local *STDIN; capture { ... } };
+
+ Modifying filehandles during a capture
+ Attempting to modify STDIN, STDOUT or STDERR *during* "capture" or "tee"
+ is almost certainly going to cause problems. Don't do that.
+
+ Forking inside a capture
+ Forks aren't portable. The behavior of filehandles during a fork is even
+ less so. If Capture::Tiny detects that a fork has occurred within a
+ capture, it will shortcut in the child process and return empty strings
+ for captures. Other problems may occur in the child or parent, as well.
+ Forking in a capture block is not recommended.
+
+ Using threads
+ Filehandles are global. Mixing up I/O and captures in different threads
+ without coordination is going to cause problems. Besides, threads are
+ officially discouraged.
+
+ Dropping privileges during a capture
+ If you drop privileges during a capture, temporary files created to
+ facilitate the capture may not be cleaned up afterwards.
+
+ No support for Perl 5.8.0
+ It's just too buggy when it comes to layers and UTF-8. Perl 5.8.1 or
+ later is recommended.
+
+ Limited support for Perl 5.6
+ Perl 5.6 predates PerlIO. UTF-8 data may not be captured correctly.
+
+ENVIRONMENT
+ PERL_CAPTURE_TINY_TIMEOUT
+ Capture::Tiny uses subprocesses internally for "tee". By default,
+ Capture::Tiny will timeout with an error if such subprocesses are not
+ ready to receive data within 30 seconds (or whatever is the value of
+ $Capture::Tiny::TIMEOUT). An alternate timeout may be specified by
+ setting the "PERL_CAPTURE_TINY_TIMEOUT" environment variable. Setting it
+ to zero will disable timeouts. NOTE, this does not timeout the code
+ reference being captured -- this only prevents Capture::Tiny itself from
+ hanging your process waiting for its child processes to be ready to
+ proceed.
+
+SEE ALSO
+ This module was inspired by IO::CaptureOutput, which provides similar
+ functionality without the ability to tee output and with more
+ complicated code and API. IO::CaptureOutput does not handle layers or
+ most of the unusual cases described in the "Limitations" section and I
+ no longer recommend it.
+
+ There are many other CPAN modules that provide some sort of output
+ capture, albeit with various limitations that make them appropriate only
+ in particular circumstances. I'm probably missing some. The long list is
+ provided to show why I felt Capture::Tiny was necessary.
+
+ * IO::Capture
+
+ * IO::Capture::Extended
+
+ * IO::CaptureOutput
+
+ * IPC::Capture
+
+ * IPC::Cmd
+
+ * IPC::Open2
+
+ * IPC::Open3
+
+ * IPC::Open3::Simple
+
+ * IPC::Open3::Utils
+
+ * IPC::Run
+
+ * IPC::Run::SafeHandles
+
+ * IPC::Run::Simple
+
+ * IPC::Run3
+
+ * IPC::System::Simple
+
+ * Tee
+
+ * IO::Tee
+
+ * File::Tee
+
+ * Filter::Handle
+
+ * Tie::STDERR
+
+ * Tie::STDOUT
+
+ * Test::Output
+
+SUPPORT
+ Bugs / Feature Requests
+ Please report any bugs or feature requests through the issue tracker at
+ <https://github.com/dagolden/Capture-Tiny/issues>. You will be notified
+ automatically of any progress on your issue.
+
+ Source Code
+ This is open source software. The code repository is available for
+ public review and contribution under the terms of the license.
+
+ <https://github.com/dagolden/Capture-Tiny>
+
+ git clone https://github.com/dagolden/Capture-Tiny.git
+
+AUTHOR
+ David Golden <dagolden@cpan.org>
+
+CONTRIBUTORS
+ * Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
+
+ * David E. Wheeler <david@justatheory.com>
+
+ * fecundf <not.com+github@gmail.com>
+
+ * Graham Knop <haarg@haarg.org>
+
+ * Peter Rabbitson <ribasushi@cpan.org>
+
+COPYRIGHT AND LICENSE
+ This software is Copyright (c) 2009 by David Golden.
+
+ This is free software, licensed under:
+
+ The Apache License, Version 2.0, January 2004
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+- Test utf8 output
+- Test with curses
--- /dev/null
+requires "Carp" => "0";
+requires "Exporter" => "0";
+requires "File::Spec" => "0";
+requires "File::Temp" => "0";
+requires "IO::Handle" => "0";
+requires "Scalar::Util" => "0";
+requires "perl" => "5.006";
+requires "strict" => "0";
+requires "warnings" => "0";
+
+on 'test' => sub {
+ requires "ExtUtils::MakeMaker" => "0";
+ requires "File::Spec" => "0";
+ requires "IO::File" => "0";
+ requires "Test::More" => "0.62";
+ requires "lib" => "0";
+};
+
+on 'test' => sub {
+ recommends "CPAN::Meta" => "2.120900";
+};
+
+on 'configure' => sub {
+ requires "ExtUtils::MakeMaker" => "6.17";
+};
+
+on 'develop' => sub {
+ requires "Dist::Zilla" => "5";
+ requires "Dist::Zilla::Plugin::OSPrereqs" => "0";
+ requires "Dist::Zilla::Plugin::Prereqs" => "0";
+ requires "Dist::Zilla::Plugin::ReleaseStatus::FromVersion" => "0";
+ requires "Dist::Zilla::Plugin::RemovePrereqs" => "0";
+ requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.072";
+ requires "File::Spec" => "0";
+ requires "File::Temp" => "0";
+ requires "IO::Handle" => "0";
+ requires "IPC::Open3" => "0";
+ requires "Pod::Coverage::TrustPod" => "0";
+ requires "Pod::Wordlist" => "0";
+ requires "Software::License::Apache_2_0" => "0";
+ requires "Test::CPAN::Meta" => "0";
+ requires "Test::MinimumVersion" => "0";
+ requires "Test::More" => "0";
+ requires "Test::Perl::Critic" => "0";
+ requires "Test::Pod" => "1.41";
+ requires "Test::Pod::Coverage" => "1.08";
+ requires "Test::Portability::Files" => "0";
+ requires "Test::Spelling" => "0.12";
+ requires "Test::Version" => "1";
+};
--- /dev/null
+name = Capture-Tiny
+author = David Golden <dagolden@cpan.org>
+license = Apache_2_0
+copyright_holder = David Golden
+copyright_year = 2009
+
+[@DAGOLDEN]
+:version = 0.072
+stopwords = UTF
+stopwords = seekable
+stopwords = prototyped
+stopwords = resending
+stopwords = undiagnosed
+
+[ReleaseStatus::FromVersion]
+testing = second_decimal_odd
+
+[OSPrereqs / MSWin32]
+Win32API::File = 0
+
+[RemovePrereqs]
+remove = PerlIO
+remove = PerlIO::scalar
+remove = Test::Differences
+; tests optionally require 5.008
+remove = perl
+
+[Prereqs]
+perl = 5.006
--- /dev/null
+use Capture::Tiny qw[ capture ];
+
+my ( $out, $err ) =
+ eval { capture { print STDERR "hello\n"; print STDOUT "there\n"; die("foo\n" ) } };
+
+print STDERR "STDERR:\nout=$out\nerr=$err\n\$@=$@";
+print STDOUT "STDOUT:\nout=$out\nerr=$err\n\$@=$@";
+
+open FILE, '>ttt.log' or die( "error opening logfile\n" );
+print FILE "FILE:\nout=$out\nerr=$err\n\$@=$@\n";
+close FILE;
--- /dev/null
+use strict;
+use warnings;
+
+use Capture::Tiny qw/capture tee/;
+
+print "Type some text. Type 'exit' to quit\n";
+my ($out, $err) = tee {
+ while (<>) {
+ last if /^exit$/;
+ print "Echoing to STDOUT: $_";
+ print STDERR "Echoing to STDERR: $_";
+ }
+};
+
+print "\nCaptured STDOUT was:\n" . ( defined $out ? $out : 'undef' );
+print "\nCaptured STDERR was:\n" . ( defined $err ? $err : 'undef' );
+
+
--- /dev/null
+use 5.006;
+use strict;
+use warnings;
+package Capture::Tiny;
+# ABSTRACT: Capture STDOUT and STDERR from Perl, XS or external programs
+our $VERSION = '0.48';
+use Carp ();
+use Exporter ();
+use IO::Handle ();
+use File::Spec ();
+use File::Temp qw/tempfile tmpnam/;
+use Scalar::Util qw/reftype blessed/;
+# Get PerlIO or fake it
+BEGIN {
+ local $@;
+ eval { require PerlIO; PerlIO->can('get_layers') }
+ or *PerlIO::get_layers = sub { return () };
+}
+
+#--------------------------------------------------------------------------#
+# create API subroutines and export them
+# [do STDOUT flag, do STDERR flag, do merge flag, do tee flag]
+#--------------------------------------------------------------------------#
+
+my %api = (
+ capture => [1,1,0,0],
+ capture_stdout => [1,0,0,0],
+ capture_stderr => [0,1,0,0],
+ capture_merged => [1,1,1,0],
+ tee => [1,1,0,1],
+ tee_stdout => [1,0,0,1],
+ tee_stderr => [0,1,0,1],
+ tee_merged => [1,1,1,1],
+);
+
+for my $sub ( keys %api ) {
+ my $args = join q{, }, @{$api{$sub}};
+ eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"; ## no critic
+}
+
+our @ISA = qw/Exporter/;
+our @EXPORT_OK = keys %api;
+our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
+
+#--------------------------------------------------------------------------#
+# constants and fixtures
+#--------------------------------------------------------------------------#
+
+my $IS_WIN32 = $^O eq 'MSWin32';
+
+##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
+##
+##my $DEBUGFH;
+##open $DEBUGFH, "> DEBUG" if $DEBUG;
+##
+##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
+
+our $TIMEOUT = 30;
+
+#--------------------------------------------------------------------------#
+# command to tee output -- the argument is a filename that must
+# be opened to signal that the process is ready to receive input.
+# This is annoying, but seems to be the best that can be done
+# as a simple, portable IPC technique
+#--------------------------------------------------------------------------#
+my @cmd = ($^X, '-C0', '-e', <<'HERE');
+use Fcntl;
+$SIG{HUP}=sub{exit};
+if ( my $fn=shift ) {
+ sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!;
+ print {$fh} $$;
+ close $fh;
+}
+my $buf; while (sysread(STDIN, $buf, 2048)) {
+ syswrite(STDOUT, $buf); syswrite(STDERR, $buf);
+}
+HERE
+
+#--------------------------------------------------------------------------#
+# filehandle manipulation
+#--------------------------------------------------------------------------#
+
+sub _relayer {
+ my ($fh, $apply_layers) = @_;
+ # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
+
+ # eliminate pseudo-layers
+ binmode( $fh, ":raw" );
+ # strip off real layers until only :unix is left
+ while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
+ binmode( $fh, ":pop" );
+ }
+ # apply other layers
+ my @to_apply = @$apply_layers;
+ shift @to_apply; # eliminate initial :unix
+ # _debug("# applying layers (unix @to_apply) to @{[fileno $fh]}\n");
+ binmode($fh, ":" . join(":",@to_apply));
+}
+
+sub _name {
+ my $glob = shift;
+ no strict 'refs'; ## no critic
+ return *{$glob}{NAME};
+}
+
+sub _open {
+ open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
+ # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
+}
+
+sub _close {
+ # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
+ close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
+}
+
+my %dup; # cache this so STDIN stays fd0
+my %proxy_count;
+sub _proxy_std {
+ my %proxies;
+ if ( ! defined fileno STDIN ) {
+ $proxy_count{stdin}++;
+ if (defined $dup{stdin}) {
+ _open \*STDIN, "<&=" . fileno($dup{stdin});
+ # _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
+ }
+ else {
+ _open \*STDIN, "<" . File::Spec->devnull;
+ # _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
+ _open $dup{stdin} = IO::Handle->new, "<&=STDIN";
+ }
+ $proxies{stdin} = \*STDIN;
+ binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic
+ }
+ if ( ! defined fileno STDOUT ) {
+ $proxy_count{stdout}++;
+ if (defined $dup{stdout}) {
+ _open \*STDOUT, ">&=" . fileno($dup{stdout});
+ # _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
+ }
+ else {
+ _open \*STDOUT, ">" . File::Spec->devnull;
+ # _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
+ _open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
+ }
+ $proxies{stdout} = \*STDOUT;
+ binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic
+ }
+ if ( ! defined fileno STDERR ) {
+ $proxy_count{stderr}++;
+ if (defined $dup{stderr}) {
+ _open \*STDERR, ">&=" . fileno($dup{stderr});
+ # _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
+ }
+ else {
+ _open \*STDERR, ">" . File::Spec->devnull;
+ # _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
+ _open $dup{stderr} = IO::Handle->new, ">&=STDERR";
+ }
+ $proxies{stderr} = \*STDERR;
+ binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic
+ }
+ return %proxies;
+}
+
+sub _unproxy {
+ my (%proxies) = @_;
+ # _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
+ for my $p ( keys %proxies ) {
+ $proxy_count{$p}--;
+ # _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
+ if ( ! $proxy_count{$p} ) {
+ _close $proxies{$p};
+ _close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
+ delete $dup{$p};
+ }
+ }
+}
+
+sub _copy_std {
+ my %handles;
+ for my $h ( qw/stdout stderr stdin/ ) {
+ next if $h eq 'stdin' && ! $IS_WIN32; # WIN32 hangs on tee without STDIN copied
+ my $redir = $h eq 'stdin' ? "<&" : ">&";
+ _open $handles{$h} = IO::Handle->new(), $redir . uc($h); # ">&STDOUT" or "<&STDIN"
+ }
+ return \%handles;
+}
+
+# In some cases we open all (prior to forking) and in others we only open
+# the output handles (setting up redirection)
+sub _open_std {
+ my ($handles) = @_;
+ _open \*STDIN, "<&" . fileno $handles->{stdin} if defined $handles->{stdin};
+ _open \*STDOUT, ">&" . fileno $handles->{stdout} if defined $handles->{stdout};
+ _open \*STDERR, ">&" . fileno $handles->{stderr} if defined $handles->{stderr};
+}
+
+#--------------------------------------------------------------------------#
+# private subs
+#--------------------------------------------------------------------------#
+
+sub _start_tee {
+ my ($which, $stash) = @_; # $which is "stdout" or "stderr"
+ # setup pipes
+ $stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
+ pipe $stash->{reader}{$which}, $stash->{tee}{$which};
+ # _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
+ select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
+ # setup desired redirection for parent and child
+ $stash->{new}{$which} = $stash->{tee}{$which};
+ $stash->{child}{$which} = {
+ stdin => $stash->{reader}{$which},
+ stdout => $stash->{old}{$which},
+ stderr => $stash->{capture}{$which},
+ };
+ # flag file is used to signal the child is ready
+ $stash->{flag_files}{$which} = scalar( tmpnam() ) . $$;
+ # execute @cmd as a separate process
+ if ( $IS_WIN32 ) {
+ my $old_eval_err=$@;
+ undef $@;
+
+ eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
+ # _debug( "# Win32API::File loaded\n") unless $@;
+ my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
+ # _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
+ my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
+ # _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
+ _open_std( $stash->{child}{$which} );
+ $stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
+ # not restoring std here as it all gets redirected again shortly anyway
+ $@=$old_eval_err;
+ }
+ else { # use fork
+ _fork_exec( $which, $stash );
+ }
+}
+
+sub _fork_exec {
+ my ($which, $stash) = @_; # $which is "stdout" or "stderr"
+ my $pid = fork;
+ if ( not defined $pid ) {
+ Carp::confess "Couldn't fork(): $!";
+ }
+ elsif ($pid == 0) { # child
+ # _debug( "# in child process ...\n" );
+ untie *STDIN; untie *STDOUT; untie *STDERR;
+ _close $stash->{tee}{$which};
+ # _debug( "# redirecting handles in child ...\n" );
+ _open_std( $stash->{child}{$which} );
+ # _debug( "# calling exec on command ...\n" );
+ exec @cmd, $stash->{flag_files}{$which};
+ }
+ $stash->{pid}{$which} = $pid
+}
+
+my $have_usleep = eval "use Time::HiRes 'usleep'; 1";
+sub _files_exist {
+ return 1 if @_ == grep { -f } @_;
+ Time::HiRes::usleep(1000) if $have_usleep;
+ return 0;
+}
+
+sub _wait_for_tees {
+ my ($stash) = @_;
+ my $start = time;
+ my @files = values %{$stash->{flag_files}};
+ my $timeout = defined $ENV{PERL_CAPTURE_TINY_TIMEOUT}
+ ? $ENV{PERL_CAPTURE_TINY_TIMEOUT} : $TIMEOUT;
+ 1 until _files_exist(@files) || ($timeout && (time - $start > $timeout));
+ Carp::confess "Timed out waiting for subprocesses to start" if ! _files_exist(@files);
+ unlink $_ for @files;
+}
+
+sub _kill_tees {
+ my ($stash) = @_;
+ if ( $IS_WIN32 ) {
+ # _debug( "# closing handles\n");
+ close($_) for values %{ $stash->{tee} };
+ # _debug( "# waiting for subprocesses to finish\n");
+ my $start = time;
+ 1 until wait == -1 || (time - $start > 30);
+ }
+ else {
+ _close $_ for values %{ $stash->{tee} };
+ waitpid $_, 0 for values %{ $stash->{pid} };
+ }
+}
+
+sub _slurp {
+ my ($name, $stash) = @_;
+ my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
+ # _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
+ seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
+ my $text = do { local $/; scalar readline $fh };
+ return defined($text) ? $text : "";
+}
+
+#--------------------------------------------------------------------------#
+# _capture_tee() -- generic main sub for capturing or teeing
+#--------------------------------------------------------------------------#
+
+sub _capture_tee {
+ # _debug( "# starting _capture_tee with (@_)...\n" );
+ my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
+ my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
+ Carp::confess("Custom capture options must be given as key/value pairs\n")
+ unless @opts % 2 == 0;
+ my $stash = { capture => { @opts } };
+ for ( keys %{$stash->{capture}} ) {
+ my $fh = $stash->{capture}{$_};
+ Carp::confess "Custom handle for $_ must be seekable\n"
+ unless ref($fh) eq 'GLOB' || (blessed($fh) && $fh->isa("IO::Seekable"));
+ }
+ # save existing filehandles and setup captures
+ local *CT_ORIG_STDIN = *STDIN ;
+ local *CT_ORIG_STDOUT = *STDOUT;
+ local *CT_ORIG_STDERR = *STDERR;
+ # find initial layers
+ my %layers = (
+ stdin => [PerlIO::get_layers(\*STDIN) ],
+ stdout => [PerlIO::get_layers(\*STDOUT, output => 1)],
+ stderr => [PerlIO::get_layers(\*STDERR, output => 1)],
+ );
+ # _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
+ # get layers from underlying glob of tied filehandles if we can
+ # (this only works for things that work like Tie::StdHandle)
+ $layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
+ if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
+ $layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
+ if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
+ # _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
+ # bypass scalar filehandles and tied handles
+ # localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
+ my %localize;
+ $localize{stdin}++, local(*STDIN)
+ if grep { $_ eq 'scalar' } @{$layers{stdin}};
+ $localize{stdout}++, local(*STDOUT)
+ if $do_stdout && grep { $_ eq 'scalar' } @{$layers{stdout}};
+ $localize{stderr}++, local(*STDERR)
+ if ($do_stderr || $do_merge) && grep { $_ eq 'scalar' } @{$layers{stderr}};
+ $localize{stdin}++, local(*STDIN), _open( \*STDIN, "<&=0")
+ if tied *STDIN && $] >= 5.008;
+ $localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
+ if $do_stdout && tied *STDOUT && $] >= 5.008;
+ $localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
+ if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
+ # _debug( "# localized $_\n" ) for keys %localize;
+ # proxy any closed/localized handles so we don't use fds 0, 1 or 2
+ my %proxy_std = _proxy_std();
+ # _debug( "# proxy std: @{ [%proxy_std] }\n" );
+ # update layers after any proxying
+ $layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
+ $layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
+ # _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
+ # store old handles and setup handles for capture
+ $stash->{old} = _copy_std();
+ $stash->{new} = { %{$stash->{old}} }; # default to originals
+ for ( keys %do ) {
+ $stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
+ seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
+ $stash->{pos}{$_} = tell $stash->{capture}{$_};
+ # _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
+ _start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
+ }
+ _wait_for_tees( $stash ) if $do_tee;
+ # finalize redirection
+ $stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
+ # _debug( "# redirecting in parent ...\n" );
+ _open_std( $stash->{new} );
+ # execute user provided code
+ my ($exit_code, $inner_error, $outer_error, $orig_pid, @result);
+ {
+ $orig_pid = $$;
+ local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
+ # _debug( "# finalizing layers ...\n" );
+ _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
+ _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
+ # _debug( "# running code $code ...\n" );
+ my $old_eval_err=$@;
+ undef $@;
+ eval { @result = $code->(); $inner_error = $@ };
+ $exit_code = $?; # save this for later
+ $outer_error = $@; # save this for later
+ STDOUT->flush if $do_stdout;
+ STDERR->flush if $do_stderr;
+ $@ = $old_eval_err;
+ }
+ # restore prior filehandles and shut down tees
+ # _debug( "# restoring filehandles ...\n" );
+ _open_std( $stash->{old} );
+ _close( $_ ) for values %{$stash->{old}}; # don't leak fds
+ # shouldn't need relayering originals, but see rt.perl.org #114404
+ _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
+ _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
+ _unproxy( %proxy_std );
+ # _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
+ _kill_tees( $stash ) if $do_tee;
+ # return captured output, but shortcut in void context
+ # unless we have to echo output to tied/scalar handles;
+ my %got;
+ if ( $orig_pid == $$ and ( defined wantarray or ($do_tee && keys %localize) ) ) {
+ for ( keys %do ) {
+ _relayer($stash->{capture}{$_}, $layers{$_});
+ $got{$_} = _slurp($_, $stash);
+ # _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
+ }
+ print CT_ORIG_STDOUT $got{stdout}
+ if $do_stdout && $do_tee && $localize{stdout};
+ print CT_ORIG_STDERR $got{stderr}
+ if $do_stderr && $do_tee && $localize{stderr};
+ }
+ $? = $exit_code;
+ $@ = $inner_error if $inner_error;
+ die $outer_error if $outer_error;
+ # _debug( "# ending _capture_tee with (@_)...\n" );
+ return unless defined wantarray;
+ my @return;
+ push @return, $got{stdout} if $do_stdout;
+ push @return, $got{stderr} if $do_stderr && ! $do_merge;
+ push @return, @result;
+ return wantarray ? @return : $return[0];
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Capture::Tiny - Capture STDOUT and STDERR from Perl, XS or external programs
+
+=head1 VERSION
+
+version 0.48
+
+=head1 SYNOPSIS
+
+ use Capture::Tiny ':all';
+
+ # capture from external command
+
+ ($stdout, $stderr, $exit) = capture {
+ system( $cmd, @args );
+ };
+
+ # capture from arbitrary code (Perl or external)
+
+ ($stdout, $stderr, @result) = capture {
+ # your code here
+ };
+
+ # capture partial or merged output
+
+ $stdout = capture_stdout { ... };
+ $stderr = capture_stderr { ... };
+ $merged = capture_merged { ... };
+
+ # tee output
+
+ ($stdout, $stderr) = tee {
+ # your code here
+ };
+
+ $stdout = tee_stdout { ... };
+ $stderr = tee_stderr { ... };
+ $merged = tee_merged { ... };
+
+=head1 DESCRIPTION
+
+Capture::Tiny provides a simple, portable way to capture almost anything sent
+to STDOUT or STDERR, regardless of whether it comes from Perl, from XS code or
+from an external program. Optionally, output can be teed so that it is
+captured while being passed through to the original filehandles. Yes, it even
+works on Windows (usually). Stop guessing which of a dozen capturing modules
+to use in any particular situation and just use this one.
+
+=head1 USAGE
+
+The following functions are available. None are exported by default.
+
+=head2 capture
+
+ ($stdout, $stderr, @result) = capture \&code;
+ $stdout = capture \&code;
+
+The C<capture> function takes a code reference and returns what is sent to
+STDOUT and STDERR as well as any return values from the code reference. In
+scalar context, it returns only STDOUT. If no output was received for a
+filehandle, it returns an empty string for that filehandle. Regardless of calling
+context, all output is captured -- nothing is passed to the existing filehandles.
+
+It is prototyped to take a subroutine reference as an argument. Thus, it
+can be called in block form:
+
+ ($stdout, $stderr) = capture {
+ # your code here ...
+ };
+
+Note that the coderef is evaluated in list context. If you wish to force
+scalar context on the return value, you must use the C<scalar> keyword.
+
+ ($stdout, $stderr, $count) = capture {
+ my @list = qw/one two three/;
+ return scalar @list; # $count will be 3
+ };
+
+Also note that within the coderef, the C<@_> variable will be empty. So don't
+use arguments from a surrounding subroutine without copying them to an array
+first:
+
+ sub wont_work {
+ my ($stdout, $stderr) = capture { do_stuff( @_ ) }; # WRONG
+ ...
+ }
+
+ sub will_work {
+ my @args = @_;
+ my ($stdout, $stderr) = capture { do_stuff( @args ) }; # RIGHT
+ ...
+ }
+
+Captures are normally done to an anonymous temporary filehandle. To
+capture via a named file (e.g. to externally monitor a long-running capture),
+provide custom filehandles as a trailing list of option pairs:
+
+ my $out_fh = IO::File->new("out.txt", "w+");
+ my $err_fh = IO::File->new("out.txt", "w+");
+ capture { ... } stdout => $out_fh, stderr => $err_fh;
+
+The filehandles must be read/write and seekable. Modifying the files or
+filehandles during a capture operation will give unpredictable results.
+Existing IO layers on them may be changed by the capture.
+
+When called in void context, C<capture> saves memory and time by
+not reading back from the capture handles.
+
+=head2 capture_stdout
+
+ ($stdout, @result) = capture_stdout \&code;
+ $stdout = capture_stdout \&code;
+
+The C<capture_stdout> function works just like C<capture> except only
+STDOUT is captured. STDERR is not captured.
+
+=head2 capture_stderr
+
+ ($stderr, @result) = capture_stderr \&code;
+ $stderr = capture_stderr \&code;
+
+The C<capture_stderr> function works just like C<capture> except only
+STDERR is captured. STDOUT is not captured.
+
+=head2 capture_merged
+
+ ($merged, @result) = capture_merged \&code;
+ $merged = capture_merged \&code;
+
+The C<capture_merged> function works just like C<capture> except STDOUT and
+STDERR are merged. (Technically, STDERR is redirected to the same capturing
+handle as STDOUT before executing the function.)
+
+Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
+properly ordered due to buffering.
+
+=head2 tee
+
+ ($stdout, $stderr, @result) = tee \&code;
+ $stdout = tee \&code;
+
+The C<tee> function works just like C<capture>, except that output is captured
+as well as passed on to the original STDOUT and STDERR.
+
+When called in void context, C<tee> saves memory and time by
+not reading back from the capture handles, except when the
+original STDOUT OR STDERR were tied or opened to a scalar
+handle.
+
+=head2 tee_stdout
+
+ ($stdout, @result) = tee_stdout \&code;
+ $stdout = tee_stdout \&code;
+
+The C<tee_stdout> function works just like C<tee> except only
+STDOUT is teed. STDERR is not teed (output goes to STDERR as usual).
+
+=head2 tee_stderr
+
+ ($stderr, @result) = tee_stderr \&code;
+ $stderr = tee_stderr \&code;
+
+The C<tee_stderr> function works just like C<tee> except only
+STDERR is teed. STDOUT is not teed (output goes to STDOUT as usual).
+
+=head2 tee_merged
+
+ ($merged, @result) = tee_merged \&code;
+ $merged = tee_merged \&code;
+
+The C<tee_merged> function works just like C<capture_merged> except that output
+is captured as well as passed on to STDOUT.
+
+Caution: STDOUT and STDERR output in the merged result are not guaranteed to be
+properly ordered due to buffering.
+
+=head1 LIMITATIONS
+
+=head2 Portability
+
+Portability is a goal, not a guarantee. C<tee> requires fork, except on
+Windows where C<system(1, @cmd)> is used instead. Not tested on any
+particularly esoteric platforms yet. See the
+L<CPAN Testers Matrix|http://matrix.cpantesters.org/?dist=Capture-Tiny>
+for test result by platform.
+
+=head2 PerlIO layers
+
+Capture::Tiny does its best to preserve PerlIO layers such as ':utf8' or
+':crlf' when capturing (only for Perl 5.8.1+) . Layers should be applied to
+STDOUT or STDERR I<before> the call to C<capture> or C<tee>. This may not work
+for tied filehandles (see below).
+
+=head2 Modifying filehandles before capturing
+
+Generally speaking, you should do little or no manipulation of the standard IO
+filehandles prior to using Capture::Tiny. In particular, closing, reopening,
+localizing or tying standard filehandles prior to capture may cause a variety of
+unexpected, undesirable and/or unreliable behaviors, as described below.
+Capture::Tiny does its best to compensate for these situations, but the
+results may not be what you desire.
+
+=head3 Closed filehandles
+
+Capture::Tiny will work even if STDIN, STDOUT or STDERR have been previously
+closed. However, since they will be reopened to capture or tee output, any
+code within the captured block that depends on finding them closed will, of
+course, not find them to be closed. If they started closed, Capture::Tiny will
+close them again when the capture block finishes.
+
+Note that this reopening will happen even for STDIN or a filehandle not being
+captured to ensure that the filehandle used for capture is not opened to file
+descriptor 0, as this causes problems on various platforms.
+
+Prior to Perl 5.12, closed STDIN combined with PERL_UNICODE=D leaks filehandles
+and also breaks tee() for undiagnosed reasons. So don't do that.
+
+=head3 Localized filehandles
+
+If code localizes any of Perl's standard filehandles before capturing, the capture
+will affect the localized filehandles and not the original ones. External system
+calls are not affected by localizing a filehandle in Perl and will continue
+to send output to the original filehandles (which will thus not be captured).
+
+=head3 Scalar filehandles
+
+If STDOUT or STDERR are reopened to scalar filehandles prior to the call to
+C<capture> or C<tee>, then Capture::Tiny will override the output filehandle for
+the duration of the C<capture> or C<tee> call and then, for C<tee>, send captured
+output to the output filehandle after the capture is complete. (Requires Perl
+5.8)
+
+Capture::Tiny attempts to preserve the semantics of STDIN opened to a scalar
+reference, but note that external processes will not be able to read from such
+a handle. Capture::Tiny tries to ensure that external processes will read from
+the null device instead, but this is not guaranteed.
+
+=head3 Tied output filehandles
+
+If STDOUT or STDERR are tied prior to the call to C<capture> or C<tee>, then
+Capture::Tiny will attempt to override the tie for the duration of the
+C<capture> or C<tee> call and then send captured output to the tied filehandle after
+the capture is complete. (Requires Perl 5.8)
+
+Capture::Tiny may not succeed resending UTF-8 encoded data to a tied
+STDOUT or STDERR filehandle. Characters may appear as bytes. If the tied filehandle
+is based on L<Tie::StdHandle>, then Capture::Tiny will attempt to determine
+appropriate layers like C<:utf8> from the underlying filehandle and do the right
+thing.
+
+=head3 Tied input filehandle
+
+Capture::Tiny attempts to preserve the semantics of tied STDIN, but this
+requires Perl 5.8 and is not entirely predictable. External processes
+will not be able to read from such a handle.
+
+Unless having STDIN tied is crucial, it may be safest to localize STDIN when
+capturing:
+
+ my ($out, $err) = do { local *STDIN; capture { ... } };
+
+=head2 Modifying filehandles during a capture
+
+Attempting to modify STDIN, STDOUT or STDERR I<during> C<capture> or C<tee> is
+almost certainly going to cause problems. Don't do that.
+
+=head3 Forking inside a capture
+
+Forks aren't portable. The behavior of filehandles during a fork is even
+less so. If Capture::Tiny detects that a fork has occurred within a
+capture, it will shortcut in the child process and return empty strings for
+captures. Other problems may occur in the child or parent, as well.
+Forking in a capture block is not recommended.
+
+=head3 Using threads
+
+Filehandles are global. Mixing up I/O and captures in different threads
+without coordination is going to cause problems. Besides, threads are
+officially discouraged.
+
+=head3 Dropping privileges during a capture
+
+If you drop privileges during a capture, temporary files created to
+facilitate the capture may not be cleaned up afterwards.
+
+=head2 No support for Perl 5.8.0
+
+It's just too buggy when it comes to layers and UTF-8. Perl 5.8.1 or later
+is recommended.
+
+=head2 Limited support for Perl 5.6
+
+Perl 5.6 predates PerlIO. UTF-8 data may not be captured correctly.
+
+=head1 ENVIRONMENT
+
+=head2 PERL_CAPTURE_TINY_TIMEOUT
+
+Capture::Tiny uses subprocesses internally for C<tee>. By default,
+Capture::Tiny will timeout with an error if such subprocesses are not ready to
+receive data within 30 seconds (or whatever is the value of
+C<$Capture::Tiny::TIMEOUT>). An alternate timeout may be specified by setting
+the C<PERL_CAPTURE_TINY_TIMEOUT> environment variable. Setting it to zero will
+disable timeouts. B<NOTE>, this does not timeout the code reference being
+captured -- this only prevents Capture::Tiny itself from hanging your process
+waiting for its child processes to be ready to proceed.
+
+=head1 SEE ALSO
+
+This module was inspired by L<IO::CaptureOutput>, which provides
+similar functionality without the ability to tee output and with more
+complicated code and API. L<IO::CaptureOutput> does not handle layers
+or most of the unusual cases described in the L</Limitations> section and
+I no longer recommend it.
+
+There are many other CPAN modules that provide some sort of output capture,
+albeit with various limitations that make them appropriate only in particular
+circumstances. I'm probably missing some. The long list is provided to show
+why I felt Capture::Tiny was necessary.
+
+=over 4
+
+=item *
+
+L<IO::Capture>
+
+=item *
+
+L<IO::Capture::Extended>
+
+=item *
+
+L<IO::CaptureOutput>
+
+=item *
+
+L<IPC::Capture>
+
+=item *
+
+L<IPC::Cmd>
+
+=item *
+
+L<IPC::Open2>
+
+=item *
+
+L<IPC::Open3>
+
+=item *
+
+L<IPC::Open3::Simple>
+
+=item *
+
+L<IPC::Open3::Utils>
+
+=item *
+
+L<IPC::Run>
+
+=item *
+
+L<IPC::Run::SafeHandles>
+
+=item *
+
+L<IPC::Run::Simple>
+
+=item *
+
+L<IPC::Run3>
+
+=item *
+
+L<IPC::System::Simple>
+
+=item *
+
+L<Tee>
+
+=item *
+
+L<IO::Tee>
+
+=item *
+
+L<File::Tee>
+
+=item *
+
+L<Filter::Handle>
+
+=item *
+
+L<Tie::STDERR>
+
+=item *
+
+L<Tie::STDOUT>
+
+=item *
+
+L<Test::Output>
+
+=back
+
+=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
+
+=head1 SUPPORT
+
+=head2 Bugs / Feature Requests
+
+Please report any bugs or feature requests through the issue tracker
+at L<https://github.com/dagolden/Capture-Tiny/issues>.
+You will be notified automatically of any progress on your issue.
+
+=head2 Source Code
+
+This is open source software. The code repository is available for
+public review and contribution under the terms of the license.
+
+L<https://github.com/dagolden/Capture-Tiny>
+
+ git clone https://github.com/dagolden/Capture-Tiny.git
+
+=head1 AUTHOR
+
+David Golden <dagolden@cpan.org>
+
+=head1 CONTRIBUTORS
+
+=for stopwords Dagfinn Ilmari Mannsåker David E. Wheeler fecundf Graham Knop Peter Rabbitson
+
+=over 4
+
+=item *
+
+Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
+
+=item *
+
+David E. Wheeler <david@justatheory.com>
+
+=item *
+
+fecundf <not.com+github@gmail.com>
+
+=item *
+
+Graham Knop <haarg@haarg.org>
+
+=item *
+
+Peter Rabbitson <ribasushi@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2009 by David Golden.
+
+This is free software, licensed under:
+
+ The Apache License, Version 2.0, January 2004
+
+=cut
--- /dev/null
+severity = 5
+verbose = 8
+
+[Variables::ProhibitPunctuationVars]
+allow = $@ $!
+
+[TestingAndDebugging::ProhibitNoStrict]
+allow = refs
+
+[Variables::ProhibitEvilVariables]
+variables = $DB::single
+
+# Turn these off
+[-BuiltinFunctions::ProhibitStringyEval]
+[-ControlStructures::ProhibitPostfixControls]
+[-ControlStructures::ProhibitUnlessBlocks]
+[-Documentation::RequirePodSections]
+[-InputOutput::ProhibitInteractiveTest]
+[-References::ProhibitDoubleSigils]
+[-RegularExpressions::RequireExtendedFormatting]
+[-InputOutput::ProhibitTwoArgOpen]
+[-Modules::ProhibitEvilModules]
+
+# Turn this on
+[Lax::ProhibitStringyEval::ExceptForRequire]
+
--- /dev/null
+do { my $x = {
+ 'configure' => {
+ 'requires' => {
+ 'ExtUtils::MakeMaker' => '6.17'
+ }
+ },
+ 'develop' => {
+ 'requires' => {
+ 'Dist::Zilla' => '5',
+ 'Dist::Zilla::Plugin::OSPrereqs' => '0',
+ 'Dist::Zilla::Plugin::Prereqs' => '0',
+ 'Dist::Zilla::Plugin::ReleaseStatus::FromVersion' => '0',
+ 'Dist::Zilla::Plugin::RemovePrereqs' => '0',
+ 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.072',
+ 'File::Spec' => '0',
+ 'File::Temp' => '0',
+ 'IO::Handle' => '0',
+ 'IPC::Open3' => '0',
+ 'Pod::Coverage::TrustPod' => '0',
+ 'Pod::Wordlist' => '0',
+ 'Software::License::Apache_2_0' => '0',
+ 'Test::CPAN::Meta' => '0',
+ 'Test::MinimumVersion' => '0',
+ 'Test::More' => '0',
+ 'Test::Perl::Critic' => '0',
+ 'Test::Pod' => '1.41',
+ 'Test::Pod::Coverage' => '1.08',
+ 'Test::Portability::Files' => '0',
+ 'Test::Spelling' => '0.12',
+ 'Test::Version' => '1'
+ }
+ },
+ 'runtime' => {
+ 'requires' => {
+ 'Carp' => '0',
+ 'Exporter' => '0',
+ 'File::Spec' => '0',
+ 'File::Temp' => '0',
+ 'IO::Handle' => '0',
+ 'Scalar::Util' => '0',
+ 'perl' => '5.006',
+ 'strict' => '0',
+ 'warnings' => '0'
+ }
+ },
+ 'test' => {
+ 'recommends' => {
+ 'CPAN::Meta' => '2.120900'
+ },
+ 'requires' => {
+ 'ExtUtils::MakeMaker' => '0',
+ 'File::Spec' => '0',
+ 'IO::File' => '0',
+ 'Test::More' => '0.62',
+ 'lib' => '0'
+ }
+ }
+ };
+ $x;
+ }
\ No newline at end of file
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027
+
+use Test::More tests => 1;
+
+use ExtUtils::MakeMaker;
+use File::Spec;
+
+# from $version::LAX
+my $lax_version_re =
+ qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
+ |
+ (?:\.[0-9]+) (?:_[0-9]+)?
+ ) | (?:
+ v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
+ |
+ (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
+ )
+ )/x;
+
+# hide optional CPAN::Meta modules from prereq scanner
+# and check if they are available
+my $cpan_meta = "CPAN::Meta";
+my $cpan_meta_pre = "CPAN::Meta::Prereqs";
+my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
+
+# Verify requirements?
+my $DO_VERIFY_PREREQS = 1;
+
+sub _max {
+ my $max = shift;
+ $max = ( $_ > $max ) ? $_ : $max for @_;
+ return $max;
+}
+
+sub _merge_prereqs {
+ my ($collector, $prereqs) = @_;
+
+ # CPAN::Meta::Prereqs object
+ if (ref $collector eq $cpan_meta_pre) {
+ return $collector->with_merged_prereqs(
+ CPAN::Meta::Prereqs->new( $prereqs )
+ );
+ }
+
+ # Raw hashrefs
+ for my $phase ( keys %$prereqs ) {
+ for my $type ( keys %{ $prereqs->{$phase} } ) {
+ for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
+ $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
+ }
+ }
+ }
+
+ return $collector;
+}
+
+my @include = qw(
+
+);
+
+my @exclude = qw(
+
+);
+
+# Add static prereqs to the included modules list
+my $static_prereqs = do './t/00-report-prereqs.dd';
+
+# Merge all prereqs (either with ::Prereqs or a hashref)
+my $full_prereqs = _merge_prereqs(
+ ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
+ $static_prereqs
+);
+
+# Add dynamic prereqs to the included modules list (if we can)
+my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
+my $cpan_meta_error;
+if ( $source && $HAS_CPAN_META
+ && (my $meta = eval { CPAN::Meta->load_file($source) } )
+) {
+ $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
+}
+else {
+ $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source)
+ $source = 'static metadata';
+}
+
+my @full_reports;
+my @dep_errors;
+my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
+
+# Add static includes into a fake section
+for my $mod (@include) {
+ $req_hash->{other}{modules}{$mod} = 0;
+}
+
+for my $phase ( qw(configure build test runtime develop other) ) {
+ next unless $req_hash->{$phase};
+ next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
+
+ for my $type ( qw(requires recommends suggests conflicts modules) ) {
+ next unless $req_hash->{$phase}{$type};
+
+ my $title = ucfirst($phase).' '.ucfirst($type);
+ my @reports = [qw/Module Want Have/];
+
+ for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
+ next if $mod eq 'perl';
+ next if grep { $_ eq $mod } @exclude;
+
+ my $file = $mod;
+ $file =~ s{::}{/}g;
+ $file .= ".pm";
+ my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
+
+ my $want = $req_hash->{$phase}{$type}{$mod};
+ $want = "undef" unless defined $want;
+ $want = "any" if !$want && $want == 0;
+
+ my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
+
+ if ($prefix) {
+ my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
+ $have = "undef" unless defined $have;
+ push @reports, [$mod, $want, $have];
+
+ if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
+ if ( $have !~ /\A$lax_version_re\z/ ) {
+ push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
+ }
+ elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
+ push @dep_errors, "$mod version '$have' is not in required range '$want'";
+ }
+ }
+ }
+ else {
+ push @reports, [$mod, $want, "missing"];
+
+ if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
+ push @dep_errors, "$mod is not installed ($req_string)";
+ }
+ }
+ }
+
+ if ( @reports ) {
+ push @full_reports, "=== $title ===\n\n";
+
+ my $ml = _max( map { length $_->[0] } @reports );
+ my $wl = _max( map { length $_->[1] } @reports );
+ my $hl = _max( map { length $_->[2] } @reports );
+
+ if ($type eq 'modules') {
+ splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
+ push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
+ }
+ else {
+ splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
+ push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
+ }
+
+ push @full_reports, "\n";
+ }
+ }
+}
+
+if ( @full_reports ) {
+ diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
+}
+
+if ( $cpan_meta_error || @dep_errors ) {
+ diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n";
+}
+
+if ( $cpan_meta_error ) {
+ my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
+ diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n";
+}
+
+if ( @dep_errors ) {
+ diag join("\n",
+ "\nThe following REQUIRED prerequisites were not satisfied:\n",
+ @dep_errors,
+ "\n"
+ );
+}
+
+pass;
+
+# vim: ts=4 sts=4 sw=4 et:
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+
+use Test::More 0.62;
+
+my @api = qw(
+ capture
+ capture_stdout
+ capture_stderr
+ capture_merged
+ tee
+ tee_stdout
+ tee_stderr
+ tee_merged
+);
+
+plan tests => 2 + 2 * @api;
+
+if ( $] eq '5.008' ) {
+ BAIL_OUT("OS unsupported: Perl 5.8.0 is too buggy for Capture::Tiny");
+}
+
+require_ok( 'Capture::Tiny' );
+
+can_ok('Capture::Tiny', $_) for @api;
+
+ok( eval "package Foo; use Capture::Tiny ':all'; 1", "import ':all' to Foo" );
+
+can_ok('Foo', $_) for @api;
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/next_fd/;
+use Cases qw/run_test/;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+
+run_test('capture');
+run_test('capture_scalar');
+run_test('capture_stdout');
+run_test('capture_stderr');
+run_test('capture_merged');
+
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+if ( $no_fork ) {
+ plan skip_all => 'tee() requires fork';
+}
+else {
+ plan 'no_plan';
+}
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+
+run_test('tee');
+run_test('tee_scalar');
+run_test('tee_stdout');
+run_test('tee_stderr');
+run_test('tee_merged');
+
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stdout/);
+ok( close STDOUT, "closed STDOUT" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+restore_std(qw/stdout/);
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stderr/);
+ok( close STDERR, "closed STDERR" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+restore_std(qw/stderr/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+# XXX work around a bug in perl; this needs to be called early-ish
+# to avoid some sort of filehandle leak when combined with Capture::Tiny
+my $qm = quotemeta("\x{263a}");
+
+save_std(qw/stdin/);
+ok( close STDIN, "closed STDIN" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ # prior to 5.12, PERL_UNICODE=D causes problems when STDIN is closed
+ # before capturing. No idea why. Documented as a known issue.
+ if ( $] lt '5.012' && ${^UNICODE} & 24 ) {
+ diag 'Skipping tee() tests because PERL_UNICODE=D not supported';
+ }
+ else {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+ }
+}
+
+if ( $] lt '5.012' && ${^UNICODE} & 24 ) {
+ diag 'Skipping leak test because PERL_UNICODE=D not supported';
+}
+else {
+ is( next_fd, $fd, "no file descriptors leaked" );
+}
+
+restore_std(qw/stdin/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/next_fd sig_num/;
+use Capture::Tiny qw/capture/;
+use Config;
+
+plan tests => 2;
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+
+capture {
+ $? = 42;
+};
+is( $?, 42, "\$\? preserved after capture ends" );
+
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "In memory files require Perl 5.8"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stdout/);
+ok( close STDOUT, "closed STDOUT" );
+ok( open( STDOUT, ">", \(my $stdout_buf)), "reopened STDOUT to string" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+restore_std(qw/stdout/);
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "In memory files require Perl 5.8"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stderr/);
+ok( close STDERR, "closed STDERR" );
+ok( open( STDERR, ">", \(my $stderr_buf)), "reopened STDERR to string" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+restore_std(qw/stderr/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "In memory files require Perl 5.8"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+#--------------------------------------------------------------------------#
+
+# pre-load PerlIO::scalar to avoid it opening on FD 0; c.f.
+# http://www.nntp.perl.org/group/perl.perl5.porters/2008/07/msg138898.html
+require PerlIO::scalar;
+
+save_std(qw/stdin/);
+ok( close STDIN, "closed STDIN" );
+ok( open( STDIN, "<", \(my $stdin_buf)), "reopened STDIN to string" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+restore_std(qw/stdin/);
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieLC;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDOUT"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stdout/);
+tie *STDOUT, 'TieLC', ">&=STDOUT";
+my $orig_tie = tied *STDOUT;
+ok( $orig_tie, "STDOUT is tied" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDOUT, $orig_tie, "STDOUT is still tied" );
+restore_std(qw/stdout/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieLC;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDERR"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stderr/);
+tie *STDERR, 'TieLC', ">&=STDERR";
+my $orig_tie = tied *STDERR;
+ok( $orig_tie, "STDERR is tied" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDERR, $orig_tie, "STDERR is still tied" );
+restore_std(qw/stderr/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieLC;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDERR"
+ if $] < 5.008;
+
+#plan skip_all => "not supported on Windows yet"
+# if $^O eq 'MSWin32';
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stdin/);
+tie *STDIN, 'TieLC', "<&=STDIN";
+my $orig_tie = tied *STDIN;
+ok( $orig_tie, "STDIN is tied" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDIN, $orig_tie, "STDIN is still tied" );
+restore_std(qw/stdin/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/next_fd sig_num/;
+use Capture::Tiny qw/capture tee/;
+use Config;
+
+plan tests => 5;
+
+local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+$@ = "initial error";
+my ($out, $err) = capture { print "foo\n" };
+is( $@, 'initial error', "Initial \$\@ not lost during capture" );
+
+
+($out, $err) = capture {
+ eval {
+ tee {
+ local $|=1;
+ print STDOUT "foo\n";
+ print STDERR "bar\n";
+ die "Fatal error in capture\n";
+ }
+ };
+};
+my $error = $@;
+
+is( $error, "Fatal error in capture\n", "\$\@ preserved after capture" );
+is( $out, "foo\n", "STDOUT still captured" );
+is( $err, "bar\n", "STDOUT still captured" );
+
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use IO::Handle;
+use Utils qw/next_fd sig_num/;
+use Capture::Tiny ':all';
+use Config;
+
+plan tests => 12;
+
+local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+my ($out, $err, $res, @res);
+
+#--------------------------------------------------------------------------#
+# capture to array
+#--------------------------------------------------------------------------#
+
+($out, $err, @res) = capture {
+ print STDOUT "foo\n";
+ print STDERR "bar\n";
+ return qw/one two three/;
+};
+
+is( $out, "foo\n", "capture -> STDOUT captured" );
+is( $err, "bar\n", "capture -> STDERR captured" );
+is_deeply( \@res, [qw/one two three/], "return values -> array" );
+
+#--------------------------------------------------------------------------#
+# capture to scalar
+#--------------------------------------------------------------------------#
+
+($out, $err, $res) = capture {
+ print STDOUT "baz\n";
+ print STDERR "bam\n";
+ return qw/one two three/;
+};
+
+is( $out, "baz\n", "capture -> STDOUT captured" );
+is( $err, "bam\n", "capture -> STDERR captured" );
+is( $res, "one", "return value -> scalar" );
+
+#--------------------------------------------------------------------------#
+# capture_stdout to array
+#--------------------------------------------------------------------------#
+
+($out, @res) = capture_stdout {
+ print STDOUT "foo\n";
+ return qw/one two three/;
+};
+
+is( $out, "foo\n", "capture_stdout -> STDOUT captured" );
+is_deeply( \@res, [qw/one two three/], "return values -> array" );
+
+#--------------------------------------------------------------------------#
+# capture_merged to array
+#--------------------------------------------------------------------------#
+
+($out, $res) = capture_merged {
+ print STDOUT "baz\n";
+ print STDERR "bam\n";
+ return qw/one two three/;
+};
+
+like( $out, qr/baz/, "capture_merged -> STDOUT captured" );
+like( $out, qr/bam/, "capture_merged -> STDERR captured" );
+is( $res, "one", "return value -> scalar" );
+
+#--------------------------------------------------------------------------#
+# finish
+#--------------------------------------------------------------------------#
+
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use IO::Handle;
+use IO::File;
+use File::Temp qw/tmpnam/;
+use Utils qw/next_fd sig_num/;
+use Capture::Tiny ':all';
+use Config;
+
+plan tests => 19;
+
+local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+my ($out, $err, $res, @res);
+
+#--------------------------------------------------------------------------#
+# capture to custom IO::File
+#--------------------------------------------------------------------------#
+
+my $temp_out = tmpnam();
+my $temp_err = tmpnam();
+
+ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
+ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
+
+my $out_fh = IO::File->new($temp_out, "w+");
+my $err_fh = IO::File->new($temp_err, "w+");
+
+capture {
+ print STDOUT "foo\n";
+ print STDERR "bar\n";
+} stdout => $out_fh, stderr => $err_fh;
+
+$out_fh->close;
+$err_fh->close;
+
+is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
+ "captured STDOUT to custom handle (IO::File)"
+);
+is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
+ "captured STDERR to custom handle (IO::File)"
+);
+
+unlink $_ for $temp_out, $temp_err;
+
+#--------------------------------------------------------------------------#
+# capture to GLOB handle
+#--------------------------------------------------------------------------#
+
+$temp_out = tmpnam();
+$temp_err = tmpnam();
+
+ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
+ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
+
+open $out_fh, "+>", $temp_out;
+open $err_fh, "+>", $temp_err;
+
+capture {
+ print STDOUT "foo\n";
+ print STDERR "bar\n";
+} stdout => $out_fh, stderr => $err_fh;
+
+$out_fh->close;
+$err_fh->close;
+
+is( scalar do {local (@ARGV,$/) = $temp_out; <>} , "foo\n",
+ "captured STDOUT to custom handle (GLOB)"
+);
+is( scalar do {local (@ARGV,$/) = $temp_err; <>} , "bar\n",
+ "captured STDERR to custom handle (GLOB)"
+);
+
+unlink $_ for $temp_out, $temp_err;
+
+#--------------------------------------------------------------------------#
+# append to custom IO::File
+#--------------------------------------------------------------------------#
+
+$temp_out = tmpnam();
+$temp_err = tmpnam();
+
+ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
+ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
+
+$out_fh = IO::File->new($temp_out, "w+");
+$err_fh = IO::File->new($temp_err, "w+");
+
+$out_fh->autoflush(1);
+$err_fh->autoflush(1);
+
+print $out_fh "Shouldn't see this in capture\n";
+print $err_fh "Shouldn't see this in capture\n";
+
+my ($got_out, $got_err) = capture {
+ print STDOUT "foo\n";
+ print STDERR "bar\n";
+} stdout => $out_fh, stderr => $err_fh;
+
+$out_fh->close;
+$err_fh->close;
+
+is( $got_out, "foo\n",
+ "captured appended STDOUT to custom handle"
+);
+is( $got_err, "bar\n",
+ "captured appended STDERR to custom handle"
+);
+
+unlink $_ for $temp_out, $temp_err;
+
+#--------------------------------------------------------------------------#
+# repeated append to custom IO::File with no output
+#--------------------------------------------------------------------------#
+
+$temp_out = tmpnam();
+$temp_err = tmpnam();
+
+ok( !-e $temp_out, "Temp out '$temp_out' doesn't exist" );
+ok( !-e $temp_err, "Temp out '$temp_err' doesn't exist" );
+
+$out_fh = IO::File->new($temp_out, "a+");
+$err_fh = IO::File->new($temp_err, "a+");
+
+($got_out, $got_err) = capture {
+ my $i = 0; $i++ for 1 .. 10; # no output, just busywork
+} stdout => $out_fh, stderr => $err_fh;
+
+is( $got_out, "",
+ "Try 1: captured empty appended STDOUT to custom handle"
+);
+is( $got_err, "",
+ "Try 1: captured empty appended STDERR to custom handle"
+);
+
+($got_out, $got_err) = capture {
+ my $i = 0; $i++ for 1 .. 10; # no output, just busywork
+} stdout => $out_fh, stderr => $err_fh;
+
+is( $got_out, "",
+ "Try 2: captured empty appended STDOUT to custom handle"
+);
+is( $got_err, "",
+ "Try 2: captured empty appended STDERR to custom handle"
+);
+
+unlink $_ for $temp_out, $temp_err;
+
+#--------------------------------------------------------------------------#
+# finish
+#--------------------------------------------------------------------------#
+
+close ARGV; # opened by reading from <>
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
+
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/next_fd sig_num/;
+use Capture::Tiny ':all';
+
+unless ( PerlIO->can('get_layers') ) {
+ plan skip_all => "Requires PerlIO::getlayers";
+}
+
+plan 'no_plan';
+
+local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # no timeouts
+
+my $builder = Test::More->builder;
+binmode( $builder->failure_output, ':utf8' ) if $] >= 5.008;
+
+my $fd = next_fd;
+my ( $out, $err, $res, @res, %before, %inner, %outer );
+
+sub _set_layers {
+ my ($fh, $new_layers) = @_;
+ # eliminate pseudo-layers
+ binmode( $fh, ":raw" ) or die "can't binmode $fh";
+ # strip off real layers until only :unix is left
+ while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
+ binmode( $fh, ":pop" ) or die "can't binmode $fh";
+ }
+ binmode($fh, $new_layers);
+}
+
+sub _get_layers {
+ return (
+ stdout => [ PerlIO::get_layers( *STDOUT, output => 1 ) ],
+ stderr => [ PerlIO::get_layers( *STDERR, output => 1 ) ],
+ );
+}
+
+sub _cmp_layers {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ my ($got, $exp, $label) = @_;
+
+ ($got, $exp) = map { ":" . join(":", @$_) } $got, $exp;
+ is( $got, $exp, $label );
+}
+
+#--------------------------------------------------------------------------#
+# relayer should duplicate layers
+#--------------------------------------------------------------------------#
+
+_set_layers( \*STDOUT, ":unix:encoding(UTF-8):encoding(UTF-8):crlf" );
+_set_layers( \*STDERR, ":unix:encoding(UTF-8):encoding(UTF-8):crlf" );
+
+%before = _get_layers();
+
+( $out, $err, @res ) = capture {
+ %inner = _get_layers();
+ print STDOUT "foo\n";
+ print STDERR "bar\n";
+};
+
+%outer = _get_layers();
+
+_cmp_layers( $inner{$_}, $before{$_}, "$_: layers inside capture match previous" )
+ for qw/stdout stderr/;
+_cmp_layers( $outer{$_}, $before{$_}, "$_: layers after capture match previous" )
+ for qw/stdout stderr/;
+
+#--------------------------------------------------------------------------#
+# finish
+#--------------------------------------------------------------------------#
+
+is( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
+# vim: set ts=4 sts=4 sw=4 et tw=75:
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieEvil;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDOUT"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+tie *STDOUT, 'TieEvil';
+my $orig_tie = tied *STDOUT;
+ok( $orig_tie, "STDOUT is tied" );
+
+my $fd = next_fd;
+
+run_test($_, '', 'skip_utf8') for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_, '', 'skip_utf8') for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDOUT, $orig_tie, "STDOUT is still tied" );
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieEvil;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDERR"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+tie *STDERR, 'TieEvil';
+my $orig_tie = tied *STDERR;
+ok( $orig_tie, "STDERR is tied" );
+
+my $fd = next_fd;
+
+run_test($_, '', 'skip_utf8') for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_, '', 'skip_utf8') for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDERR, $orig_tie, "STDERR is still tied" );
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieEvil;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDIN"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+tie *STDIN, 'TieEvil';
+my $orig_tie = tied *STDIN;
+ok( $orig_tie, "STDIN is tied" );
+
+my $fd = next_fd;
+
+run_test($_, '', 'skip_utf8') for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_, '', 'skip_utf8') for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDIN, $orig_tie, "STDIN is still tied" );
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieLC;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDOUT"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+save_std(qw/stdout stderr stdin/);
+tie *STDOUT, 'TieLC', ">&=STDOUT";
+my $out_tie = tied *STDOUT;
+ok( $out_tie, "STDOUT is tied" );
+tie *STDERR, 'TieLC', ">&=STDERR";
+my $err_tie = tied *STDERR;
+ok( $err_tie, "STDERR is tied" );
+tie *STDIN, 'TieLC', "<&=STDIN";
+my $in_tie = tied *STDIN;
+ok( $in_tie, "STDIN is tied" );
+
+my $fd = next_fd;
+
+run_test($_) for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_) for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDOUT, $out_tie, "STDOUT is still tied" );
+is( tied *STDERR, $err_tie, "STDERR is still tied" );
+is( tied *STDIN, $in_tie, "STDIN is still tied" );
+restore_std(qw/stdout stderr stdin/);
+
+exit 0;
--- /dev/null
+# Copyright (c) 2009 by David Golden. All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/save_std restore_std next_fd/;
+use Cases qw/run_test/;
+use TieEvil;
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+
+plan skip_all => "capture needs Perl 5.8 for tied STDIN"
+ if $] < 5.008;
+
+plan 'no_plan';
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+binmode($builder->todo_output, ':utf8') if $] >= 5.008;
+
+tie *STDIN, 'TieEvil';
+my $in_tie = tied *STDIN;
+ok( $in_tie, "STDIN is tied" );
+
+tie *STDOUT, 'TieEvil';
+my $out_tie = tied *STDOUT;
+ok( $out_tie, "STDIN is tied" );
+
+tie *STDERR, 'TieEvil';
+my $err_tie = tied *STDERR;
+ok( $err_tie, "STDIN is tied" );
+
+my $fd = next_fd;
+
+run_test($_, '', 'skip_utf8') for qw(
+ capture
+ capture_scalar
+ capture_stdout
+ capture_stderr
+ capture_merged
+);
+
+if ( ! $no_fork ) {
+ run_test($_, '', 'skip_utf8') for qw(
+ tee
+ tee_scalar
+ tee_stdout
+ tee_stderr
+ tee_merged
+ );
+}
+
+is( next_fd, $fd, "no file descriptors leaked" );
+is( tied *STDIN, $in_tie, "STDIN is still tied" );
+is( tied *STDOUT, $out_tie, "STDOUT is still tied" );
+is( tied *STDERR, $err_tie, "STDERR is still tied" );
+
+exit 0;
--- /dev/null
+# By Yary Hluchan with portions copied from David Golden
+# Copyright (c) 2015 assigned by Yary Hluchan to David Golden.
+# All rights reserved.
+# Licensed under Apache License, Version 2.0 (the "License").
+# You may not use this file except in compliance with the License.
+# A copy of the License was distributed with this file or you may obtain a
+# copy of the License from http://www.apache.org/licenses/LICENSE-2.0
+
+use strict;
+use warnings;
+use Test::More;
+use lib 't/lib';
+use Utils qw/next_fd/;
+use Capture::Tiny 'capture';
+
+use Config;
+my $no_fork = $^O ne 'MSWin32' && ! $Config{d_fork};
+if ( $no_fork ) {
+ plan skip_all => 'tee() requires fork';
+}
+else {
+ plan 'no_plan';
+}
+
+my $builder = Test::More->builder;
+binmode($builder->failure_output, ':utf8') if $] >= 5.008;
+
+my $fd = next_fd;
+
+
+my ($stdout, $stderr, @result) = capture {
+ if (!defined(my $child = fork)) { die "fork() failed" }
+ elsif ($child == 0) {
+ print "Happiness";
+ print STDERR "Certainty\n";
+ exit;
+ }
+ else {
+ wait;
+ print ", a parent-ly\n";
+ }
+ return qw(a b c);
+};
+
+is ( $stdout, "Happiness, a parent-ly\n", "got stdout");
+is ( $stderr, "Certainty\n", "got stderr");
+is ( "@result", "a b c" , "got result");
+is ( next_fd, $fd, "no file descriptors leaked" );
+
+exit 0;
--- /dev/null
+package Cases;
+use strict;
+use warnings;
+use Test::More;
+use Capture::Tiny ':all';
+
+require Exporter;
+our @ISA = 'Exporter';
+our @EXPORT_OK = qw(
+ run_test
+);
+
+my $locale_ok = eval {
+ my $err = capture_stderr { system($^X, '-we', 1) };
+ $err !~ /setting locale failed/i;
+};
+
+my $have_diff = eval {
+ require Test::Differences;
+ Test::Differences->import;
+ $Test::Differences::VERSION < 0.60; # 0.60+ is causing strange failures
+};
+
+sub _is_or_diff {
+ my ($g,$e,$l) = @_;
+ if ( $have_diff ) { eq_or_diff( $g, $e, $l ); }
+ else { is( $g, $e, $l ); }
+}
+
+sub _binmode {
+ my $text = shift;
+ return $text eq 'unicode' ? 'binmode(STDOUT,q{:utf8}); binmode(STDERR,q{:utf8});' : '';
+}
+
+sub _set_utf8 {
+ my $t = shift;
+ return unless $t eq 'unicode';
+ my %seen;
+ my @orig_layers = (
+ [ grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{stdout}{$_}++} PerlIO::get_layers(\*STDOUT) ],
+ [ grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{stderr}{$_}++} PerlIO::get_layers(\*STDERR) ],
+ );
+ binmode(STDOUT, ":utf8") if fileno(STDOUT);
+ binmode(STDERR, ":utf8") if fileno(STDERR);
+ return @orig_layers;
+}
+
+sub _restore_layers {
+ my ($t, @orig_layers) = @_;
+ return unless $t eq 'unicode';
+ binmode(STDOUT, join( ":", "", "raw", @{$orig_layers[0]})) if fileno(STDOUT);
+ binmode(STDERR, join( ":", "", "raw", @{$orig_layers[1]})) if fileno(STDERR);
+}
+
+#--------------------------------------------------------------------------#
+
+my %texts = (
+ short => 'Hello World',
+ multiline => 'First line\nSecond line\n',
+ ( $] lt "5.008" ? () : ( unicode => 'Hi! \x{263a}\n') ),
+);
+
+#--------------------------------------------------------------------------#
+# fcn($perl_code_string) => execute the perl in current process or subprocess
+#--------------------------------------------------------------------------#
+
+my %methods = (
+ perl => sub { eval $_[0] },
+ sys => sub { system($^X, '-e', $_[0]) },
+);
+
+#--------------------------------------------------------------------------#
+
+my %channels = (
+ stdout => {
+ output => sub { _binmode($_[0]) . "print STDOUT qq{STDOUT:$texts{$_[0]}}" },
+ expect => sub { eval "qq{STDOUT:$texts{$_[0]}}", "" },
+ },
+ stderr => {
+ output => sub { _binmode($_[0]) . "print STDERR qq{STDERR:$texts{$_[0]}}" },
+ expect => sub { "", eval "qq{STDERR:$texts{$_[0]}}" },
+ },
+ both => {
+ output => sub { _binmode($_[0]) . "print STDOUT qq{STDOUT:$texts{$_[0]}}; print STDERR qq{STDERR:$texts{$_[0]}}" },
+ expect => sub { eval "qq{STDOUT:$texts{$_[0]}}", eval "qq{STDERR:$texts{$_[0]}}" },
+ },
+ empty => {
+ output => sub { _binmode($_[0]) . "print STDOUT qq{}; print STDERR qq{}" },
+ expect => sub { "", "" },
+ },
+ nooutput=> {
+ output => sub { _binmode($_[0]) },
+ expect => sub { "", "" },
+ },
+);
+
+#--------------------------------------------------------------------------#
+
+my %tests = (
+ capture => {
+ cnt => 2,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($got_out, $got_err) = capture {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );
+ _is_or_diff( $got_err, $expected[1], "$l|$m|$c|$t - got STDERR" );
+ },
+ },
+ capture_scalar => {
+ cnt => 1,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my $got_out = capture {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );
+ },
+ },
+ capture_stdout => {
+ cnt => 3,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($inner_out, $inner_err);
+ my ($outer_out, $outer_err) = capture {
+ $inner_out = capture_stdout {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $inner_out, $expected[0], "$l|$m|$c|$t - inner STDOUT" );
+ _is_or_diff( $outer_out, "", "$l|$m|$c|$t - outer STDOUT" );
+ _is_or_diff( $outer_err, $expected[1], "$l|$m|$c|$t - outer STDERR" );
+ },
+ },
+ capture_stderr => {
+ cnt => 3,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($inner_out, $inner_err);
+ my ($outer_out, $outer_err) = capture {
+ $inner_err = capture_stderr {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $inner_err, $expected[1], "$l|$m|$c|$t - inner STDERR" );
+ _is_or_diff( $outer_out, $expected[0], "$l|$m|$c|$t - outer STDOUT" );
+ _is_or_diff( $outer_err, "", "$l|$m|$c|$t - outer STDERR" );
+ },
+ },
+ capture_merged => {
+ cnt => 2,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my $got_out = capture_merged {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ like( $got_out, qr/\Q$expected[0]\E/, "$l|$m|$c|$t - got STDOUT" );
+ like( $got_out, qr/\Q$expected[1]\E/, "$l|$m|$c|$t - got STDERR" );
+ },
+ },
+ tee => {
+ cnt => 4,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($got_out, $got_err);
+ my ($tee_out, $tee_err) = capture {
+ ($got_out, $got_err) = tee {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );
+ _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - tee STDOUT" );
+ _is_or_diff( $got_err, $expected[1], "$l|$m|$c|$t - got STDERR" );
+ _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - tee STDERR" );
+ }
+ },
+ tee_scalar => {
+ cnt => 3,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($got_out, $got_err);
+ my ($tee_out, $tee_err) = capture {
+ $got_out = tee {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );
+ _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - tee STDOUT" );
+ _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - tee STDERR" );
+ }
+ },
+ tee_stdout => {
+ cnt => 3,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($inner_out, $inner_err);
+ my ($tee_out, $tee_err) = capture {
+ $inner_out = tee_stdout {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $inner_out, $expected[0], "$l|$m|$c|$t - inner STDOUT" );
+ _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - teed STDOUT" );
+ _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - unmodified STDERR" );
+ }
+ },
+ tee_stderr => {
+ cnt => 3,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($inner_out, $inner_err);
+ my ($tee_out, $tee_err) = capture {
+ $inner_err = tee_stderr {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ _is_or_diff( $inner_err, $expected[1], "$l|$m|$c|$t - inner STDOUT" );
+ _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - unmodified STDOUT" );
+ _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - teed STDERR" );
+ }
+ },
+ tee_merged => {
+ cnt => 5,
+ test => sub {
+ my ($m, $c, $t, $l) = @_;
+ my ($got_out, $got_err);
+ my ($tee_out, $tee_err) = capture {
+ $got_out = tee_merged {
+ $methods{$m}->( $channels{$c}{output}->($t) );
+ };
+ };
+ my @expected = $channels{$c}{expect}->($t);
+ like( $got_out, qr/\Q$expected[0]\E/, "$l|$m|$c|$t - got STDOUT" );
+ like( $got_out, qr/\Q$expected[1]\E/, "$l|$m|$c|$t - got STDERR" );
+ like( $tee_out, qr/\Q$expected[0]\E/, "$l|$m|$c|$t - tee STDOUT (STDOUT)" );
+ like( $tee_out, qr/\Q$expected[1]\E/, "$l|$m|$c|$t - tee STDOUT (STDERR)" );
+ _is_or_diff( $tee_err, '', "$l|$m|$c|$t - tee STDERR" );
+ }
+ },
+);
+
+#--------------------------------------------------------------------------#
+# What I want to be able to do:
+#
+# test_it(
+# input => 'short',
+# channels => 'both',
+# method => 'perl'
+# )
+
+sub run_test {
+ my $test_type = shift or return;
+ my $todo = shift || '';
+ my $skip_utf8 = shift || '';
+ local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # don't timeout during testing
+ for my $m ( keys %methods ) {
+ if ( ($m eq 'sys' || substr($test_type,0,3) eq 'tee' ) && ! $locale_ok ) {
+ SKIP: {
+ skip "Perl could not initialize locale", 1
+ };
+ next;
+ }
+ for my $c ( keys %channels ) {
+ for my $t ( keys %texts ) {
+ next if $t eq 'unicode' && $skip_utf8;
+ my @orig_layers = _set_utf8($t);
+ local $TODO = "not supported on all platforms"
+ if $t eq $todo;
+ $tests{$test_type}{test}->($m, $c, $t, $test_type);
+ _restore_layers($t, @orig_layers);
+ }
+ }
+ }
+}
+
+1;
--- /dev/null
+package TieEvil;
+# FCGI tied with a scalar ref object, which breaks when you
+# call open on it. Emulate that to test the workaround:
+use Carp ();
+
+sub TIEHANDLE
+{
+ my $class = shift;
+ my $fh = \(my $scalar); # this is evil and broken
+ return bless $fh,$class;
+}
+
+sub EOF { 0 }
+sub TELL { length ${$_[0]} }
+sub FILENO { -1 }
+sub SEEK { 1 }
+sub CLOSE { 1 }
+sub BINMODE { 1 }
+
+sub OPEN { Carp::confess "unimplemented" }
+
+sub READ { $_[1] = substr(${$_[0]},$_[3],$_[2]) }
+sub READLINE { "hello world\n" }
+sub GETC { substr(${$_[0]},0,1) }
+
+sub PRINT {
+ my ($self, @what) = @_;
+ my $new = join($\, @what);
+ $$self .= $new;
+ return length $new;
+}
+
+sub UNTIE { 1 }; # suppress warnings about references
+
+1;
--- /dev/null
+package TieLC;
+
+sub TIEHANDLE
+{
+ my $class = shift;
+ my $fh = \do { local *HANDLE};
+ bless $fh,$class;
+ $fh->OPEN(@_) if (@_);
+ $fh->BINMODE(':utf8');
+ return $fh;
+}
+
+sub EOF { eof($_[0]) }
+sub TELL { tell($_[0]) }
+sub FILENO { fileno($_[0]) }
+sub SEEK { seek($_[0],$_[1],$_[2]) }
+sub CLOSE { close($_[0]) }
+sub BINMODE { binmode($_[0],$_[1]) }
+
+sub OPEN
+{
+ $_[0]->CLOSE if defined($_[0]->FILENO);
+ @_ == 2 ? open($_[0], $_[1]) : open($_[0], $_[1], $_[2]);
+}
+
+sub READ { read($_[0],$_[1],$_[2]) }
+sub READLINE { "hello world\n" }
+sub GETC { getc($_[0]) }
+
+sub WRITE
+{
+ my $fh = $_[0];
+ print $fh substr($_[1],0,$_[2])
+}
+
+sub PRINT {
+ my ($self, @what) = @_;
+ my $buf = lc join('', @what);
+ $self->WRITE($buf, length($buf), 0);
+}
+
+sub UNTIE { 1 }; # suppress warnings about references
+
+1;
--- /dev/null
+package Utils;
+use strict;
+use warnings;
+use File::Spec;
+use Config;
+
+require Exporter;
+our @ISA = 'Exporter';
+our @EXPORT = qw/save_std restore_std next_fd sig_num/;
+
+sub _open {
+ open $_[0], $_[1] or die "Error from open( " . join(q{, }, @_) . "): $!";
+}
+
+my @saved;
+sub save_std {
+ for my $h ( @_ ) {
+ my $fh;
+ _open $fh, ($h eq 'stdin' ? "<&" : ">&") . uc $h;
+ push @saved, $fh;
+ }
+}
+
+sub restore_std {
+ for my $h ( @_ ) {
+ no strict 'refs';
+ my $fh = shift @saved;
+ _open \*{uc $h}, ($h eq 'stdin' ? "<&" : ">&") . fileno( $fh );
+ close $fh;
+ }
+}
+
+sub next_fd {
+ no warnings 'io';
+ open my $fh, ">", File::Spec->devnull;
+ my $fileno = fileno $fh;
+ close $fh;
+ return $fileno;
+}
+
+#--------------------------------------------------------------------------#
+
+my %sig_num;
+my @sig_name;
+unless($Config{sig_name} && $Config{sig_num}) {
+ die "No sigs?";
+} else {
+ my @names = split ' ', $Config{sig_name};
+ @sig_num{@names} = split ' ', $Config{sig_num};
+ foreach (@names) {
+ $sig_name[$sig_num{$_}] ||= $_;
+ }
+}
+
+sub sig_num {
+ my $name = shift;
+ return exists $sig_num{$name} ? $sig_num{$name} : '';
+}
+
+1;
--- /dev/null
+use 5.006;
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058
+
+use Test::More;
+
+plan tests => 2;
+
+my @module_files = (
+ 'Capture/Tiny.pm'
+);
+
+
+
+# fake home for cpan-testers
+use File::Temp;
+local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 );
+
+
+my @switches = (
+ -d 'blib' ? '-Mblib' : '-Ilib',
+);
+
+use File::Spec;
+use IPC::Open3;
+use IO::Handle;
+
+open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";
+
+my @warnings;
+for my $lib (@module_files)
+{
+ # see L<perlfaq8/How can I capture STDERR from an external command?>
+ my $stderr = IO::Handle->new;
+
+ diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
+ $^X, @switches, '-e', "require q[$lib]"))
+ if $ENV{PERL_COMPILE_TEST_DEBUG};
+
+ my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
+ binmode $stderr, ':crlf' if $^O eq 'MSWin32';
+ my @_warnings = <$stderr>;
+ waitpid($pid, 0);
+ is($?, 0, "$lib loaded ok");
+
+ shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
+ and not eval { +require blib; blib->VERSION('1.01') };
+
+ if (@_warnings)
+ {
+ warn @_warnings;
+ push @warnings, @_warnings;
+ }
+}
+
+
+
+is(scalar(@warnings), 0, 'no warnings found')
+ or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) );
+
+
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc";
+all_critic_ok();
--- /dev/null
+#!perl
+
+use Test::More;
+
+use Test::MinimumVersion;
+all_minimum_version_ok( qq{5.010} );
--- /dev/null
+#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests.
+
+use Test::Pod::Coverage 1.08;
+use Pod::Coverage::TrustPod;
+
+all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' });
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+# generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005
+use Test::Spelling 0.12;
+use Pod::Wordlist;
+
+
+add_stopwords(<DATA>);
+all_pod_files_spelling_ok( qw( bin lib ) );
+__DATA__
+Capture
+Dagfinn
+David
+Golden
+Graham
+Ilmari
+Knop
+Mannsåker
+Peter
+Rabbitson
+Tiny
+UTF
+Wheeler
+dagolden
+david
+fecundf
+haarg
+ilmari
+lib
+not
+prototyped
+resending
+ribasushi
+seekable
+undiagnosed
--- /dev/null
+#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
+use strict; use warnings;
+use Test::More;
+use Test::Pod 1.41;
+
+all_pod_files_ok();
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+
+eval 'use Test::Portability::Files';
+plan skip_all => 'Test::Portability::Files required for testing portability'
+ if $@;
+options(test_one_dot => 0);
+run_tests();
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+# generated by Dist::Zilla::Plugin::Test::Version 1.09
+use Test::Version;
+
+my @imports = qw( version_all_ok );
+
+my $params = {
+ is_strict => 0,
+ has_version => 1,
+ multiple => 0,
+
+};
+
+push @imports, $params
+ if version->parse( $Test::Version::VERSION ) >= version->parse('1.002');
+
+Test::Version->import(@imports);
+
+version_all_ok;
+done_testing;
--- /dev/null
+#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::MetaTests.
+
+use Test::CPAN::Meta;
+
+meta_yaml_ok();
projects / platform / upstream / perl-Capture-Tiny.git / commitdiff