File Coverage

File:inc/IO/Catch.pm
Coverage:73.7%

linestmtbrancondsubpodtimecode
1package IO::Catch;
2
2
2
2
2
10
4
10
use strict;
3
2
2
2
2
12
5
20
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
2
2
2
2
14
4
13
use vars qw($VERSION);
27
28$VERSION = '0.02';
29
30sub TIEHANDLE {
31
4
4
28
    my($class, $var) = @_;
32
4
100
21
    croak "Need a variable name to tie to" unless $var;
33
3
22
    return bless { var => $var }, $class;
34}
35
36sub PRINT {
37
2
2
2
2
14
5
22
    no strict 'refs';
38
1
1
9
    my($self) = shift;
39
1
1
6
10
    ${'main::'.$self->{var}} = ""
40
1
50
3
      unless defined ${'main::'.$self->{var}};
41
1
1
2
8
    ${'main::'.$self->{var}} .= join '', @_;
42}
43
44sub PRINTF {
45
2
2
2
2
13
4
9
    no strict 'refs';
46
1
1
60
    my($self) = shift;
47
1
4
    my $tmpl = shift;
48
0
1
0
10
    ${'main::'.$self->{var}} = ""
49
1
50
3
      unless defined ${'main::'.$self->{var}};
50
1
1
2
10
    ${'main::'.$self->{var}} .= sprintf $tmpl, @_;
51}
52
53
0
0
sub OPEN {} # XXX Hackery in case the user redirects
54
0
0
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
55
56
0
0
sub READ {}
57
0
0
sub READLINE {}
58
0
0
sub GETC {}
59
0
0
sub BINMODE {}
60
611;