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