1package Test::Builder::NoOutput;
2
3use strict;
4use warnings;
5
6use base qw(Test::Builder);
7
8
9=head1 NAME
10
11Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing
12
13=head1 SYNOPSIS
14
15    use Test::Builder::NoOutput;
16
17    my $tb = Test::Builder::NoOutput->new;
18
19    ...test as normal...
20
21    my $output = $tb->read;
22
23=head1 DESCRIPTION
24
25This is a subclass of Test::Builder which traps all its output.
26It is mostly useful for testing Test::Builder.
27
28=head3 read
29
30    my $all_output = $tb->read;
31    my $output     = $tb->read($stream);
32
33Returns all the output (including failure and todo output) collected
34so far.  It is destructive, each call to read clears the output
35buffer.
36
37If $stream is given it will return just the output from that stream.
38$stream's are...
39
40    out         output()
41    err         failure_output()
42    todo        todo_output()
43    all         all outputs
44
45Defaults to 'all'.
46
47=cut
48
49my $Test = __PACKAGE__->new;
50
51sub create {
52    my $class = shift;
53    my $self = $class->SUPER::create(@_);
54
55    my %outputs = (
56        all  => '',
57        out  => '',
58        err  => '',
59        todo => '',
60    );
61    $self->{_outputs} = \%outputs;
62
63    tie *OUT,  "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out};
64    tie *ERR,  "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err};
65    tie *TODO, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo};
66
67    $self->output(*OUT);
68    $self->failure_output(*ERR);
69    $self->todo_output(*TODO);
70
71    return $self;
72}
73
74sub read {
75    my $self = shift;
76    my $stream = @_ ? shift : 'all';
77
78    my $out = $self->{_outputs}{$stream};
79
80    $self->{_outputs}{$stream} = '';
81
82    # Clear all the streams if 'all' is read.
83    if( $stream eq 'all' ) {
84        my @keys = keys %{$self->{_outputs}};
85        $self->{_outputs}{$_} = '' for @keys;
86    }
87
88    return $out;
89}
90
91
92package Test::Builder::NoOutput::Tee;
93
94# A cheap implementation of IO::Tee.
95
96sub TIEHANDLE {
97    my($class, @refs) = @_;
98
99    my @fhs;
100    for my $ref (@refs) {
101        my $fh = Test::Builder->_new_fh($ref);
102        push @fhs, $fh;
103    }
104
105    my $self = [@fhs];
106    return bless $self, $class;
107}
108
109sub PRINT {
110    my $self = shift;
111
112    print $_ @_ for @$self;
113}
114
115sub PRINTF {
116    my $self   = shift;
117    my $format = shift;
118
119    printf $_ @_ for @$self;
120}
121
1221;
123