File: | inc/IO/Catch.pm |
Coverage: | 43.9% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package IO::Catch; | ||||||
2 | 1 1 1 | 4 2 5 | use strict; | ||||
3 | 1 1 1 | 6 2 10 | use Carp qw(croak); | ||||
4 | |||||||
5 - 24 | =head1 NAME IO::Catch - capture STDOUT and STDERR into global variables =head1 AUTHOR Max Maischein ( corion at cpan.org ) All code ripped from pod2test by M. Schwern =head1 SYNOPSIS # pre-5.8.0's warns aren't caught by a tied STDERR. use vars qw($_STDOUT_, $_STDERR_); tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; # now you can access $main::_STDOUT_ and $_STDERR_ # to see the output. =cut | ||||||
25 | |||||||
26 | 1 1 1 | 7 2 7 | use vars qw($VERSION); | ||||
27 | |||||||
28 | $VERSION = '0.02'; | ||||||
29 | |||||||
30 | sub TIEHANDLE { | ||||||
31 | 2 | 12 | my($class, $var) = @_; | ||||
32 | 2 | 7 | croak "Need a variable name to tie to" unless $var; | ||||
33 | 2 | 15 | return bless { var => $var }, $class; | ||||
34 | } | ||||||
35 | |||||||
36 | sub PRINT { | ||||||
37 | 1 1 1 | 7 2 16 | no strict 'refs'; | ||||
38 | 0 | my($self) = shift; | |||||
39 | 0 0 | ${'main::'.$self->{var}} = "" | |||||
40 | 0 | unless defined ${'main::'.$self->{var}}; | |||||
41 | 0 0 | ${'main::'.$self->{var}} .= join '', @_; | |||||
42 | } | ||||||
43 | |||||||
44 | sub PRINTF { | ||||||
45 | 1 1 1 | 7 2 4 | no strict 'refs'; | ||||
46 | 0 | my($self) = shift; | |||||
47 | 0 | my $tmpl = shift; | |||||
48 | 0 0 | ${'main::'.$self->{var}} = "" | |||||
49 | 0 | unless defined ${'main::'.$self->{var}}; | |||||
50 | 0 0 | ${'main::'.$self->{var}} .= sprintf $tmpl, @_; | |||||
51 | } | ||||||
52 | |||||||
53 | 0 | sub OPEN {} # XXX Hackery in case the user redirects | |||||
54 | 0 | sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want. | |||||
55 | |||||||
56 | 0 | sub READ {} | |||||
57 | 0 | sub READLINE {} | |||||
58 | 0 | sub GETC {} | |||||
59 | 0 | sub BINMODE {} | |||||
60 | |||||||
61 | 1; |