File Coverage

inc/IO/Catch.pm
Criterion Covered Total %
statement 28 28 100.0
branch 5 6 83.3
condition n/a
subroutine 7 13 53.8
pod n/a
total 40 47 85.1


line stmt bran cond sub pod time code
1             package IO::Catch;
2 22     22   791545 use strict;
  22         177  
  22         635  
3 22     22   99 use Carp qw(croak);
  22         36  
  22         3199  
4              
5             =head1 NAME
6              
7             IO::Catch - capture STDOUT and STDERR into global variables
8              
9             =head1 AUTHOR
10              
11             Max Maischein ( corion at cpan.org )
12             All code ripped from pod2test by M. Schwern
13              
14             =head1 SYNOPSIS
15              
16             # pre-5.8.0's warns aren't caught by a tied STDERR.
17             our ($_STDOUT_, $_STDERR_);
18             tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
19             tie *STDERR, 'IO::Catch', '_STDERR_' or die $!;
20              
21             # now you can access $main::_STDOUT_ and $_STDERR_
22             # to see the output.
23              
24             =cut
25              
26             our $VERSION = '0.02';
27              
28             sub TIEHANDLE {
29 32     32   1947 my($class, $var) = @_;
30 32 50       90 croak "Need a variable name to tie to" unless $var;
31 32         134 return bless { var => $var }, $class;
32             }
33              
34             sub PRINT {
35 22     22   142 no strict 'refs';
  22         47  
  22         2502  
36 134     134   1479 my($self) = shift;
37 16         118 ${'main::'.$self->{var}} = ""
38 134 100       190 unless defined ${'main::'.$self->{var}};
  134         761  
39 134         209 ${'main::'.$self->{var}} .= join '', @_;
  134         1453  
40             }
41              
42             sub PRINTF {
43 22     22   178 no strict 'refs';
  22         54  
  22         3518  
44 40     40   46 my($self) = shift;
45 40         39 my $tmpl = shift;
46 6         13 ${'main::'.$self->{var}} = ""
47 40 100       29 unless defined ${'main::'.$self->{var}};
  40         94  
48 40         35 ${'main::'.$self->{var}} .= sprintf $tmpl, @_;
  40         206  
49             }
50              
51       0     sub OPEN {} # XXX Hackery in case the user redirects
52       0     sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
53              
54       0     sub READ {}
55       0     sub READLINE {}
56       0     sub GETC {}
57       0     sub BINMODE {}
58              
59             1;