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   920820 use strict;
  22         181  
  22         698  
3 22     22   125 use Carp qw(croak);
  22         40  
  22         3098  
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   2264 my($class, $var) = @_;
30 32 50       108 croak "Need a variable name to tie to" unless $var;
31 32         143 return bless { var => $var }, $class;
32             }
33              
34             sub PRINT {
35 22     22   149 no strict 'refs';
  22         51  
  22         2750  
36 134     134   2053 my($self) = shift;
37 16         123 ${'main::'.$self->{var}} = ""
38 134 100       225 unless defined ${'main::'.$self->{var}};
  134         860  
39 134         233 ${'main::'.$self->{var}} .= join '', @_;
  134         1712  
40             }
41              
42             sub PRINTF {
43 22     22   142 no strict 'refs';
  22         39  
  22         4068  
44 40     40   103 my($self) = shift;
45 40         49 my $tmpl = shift;
46 6         21 ${'main::'.$self->{var}} = ""
47 40 100       41 unless defined ${'main::'.$self->{var}};
  40         123  
48 40         51 ${'main::'.$self->{var}} .= sprintf $tmpl, @_;
  40         268  
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;