File Coverage

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

linestmtbrancondsubpodtimecode
1package IO::Catch;
2
1
1
1
1
4
2
5
use strict;
3
1
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
1
7
2
7
use vars qw($VERSION);
27
28$VERSION = '0.02';
29
30sub TIEHANDLE {
31
2
2
12
    my($class, $var) = @_;
32
2
50
7
    croak "Need a variable name to tie to" unless $var;
33
2
15
    return bless { var => $var }, $class;
34}
35
36sub PRINT {
37
1
1
1
1
7
2
16
    no strict 'refs';
38
0
0
    my($self) = shift;
39
0
0
    ${'main::'.$self->{var}} = ""
40
0
0
      unless defined ${'main::'.$self->{var}};
41
0
0
    ${'main::'.$self->{var}} .= join '', @_;
42}
43
44sub PRINTF {
45
1
1
1
1
7
2
4
    no strict 'refs';
46
0
0
    my($self) = shift;
47
0
    my $tmpl = shift;
48
0
0
    ${'main::'.$self->{var}} = ""
49
0
0
      unless defined ${'main::'.$self->{var}};
50
0
0
    ${'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;