ext/Test-Simple/t/lib/Test/Builder/NoOutput.pm

   1 package Test::Builder::NoOutput;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw(Test::Builder);
   7
   8
   9 =head1 NAME
  10
  11 Test::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
  25 This is a subclass of Test::Builder which traps all its output.
  26 It 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
  33 Returns all the output (including failure and todo output) collected
  34 so far.  It is destructive, each call to read clears the output
  35 buffer.
  36
  37 If $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
  45 Defaults to 'all'.
  46
  47 =cut
  48
  49 my $Test = __PACKAGE__->new;
  50
  51 sub 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
  74 sub 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
  92 package Test::Builder::NoOutput::Tee;
  93
  94 # A cheap implementation of IO::Tee.
  95
  96 sub 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
 109 sub PRINT {
 110     my $self = shift;
 111
 112     print $_ @_ for @$self;
 113 }
 114
 115 sub PRINTF {
 116     my $self   = shift;
 117     my $format = shift;
 118
 119     printf $_ @_ for @$self;
 120 }
 121
 122 1;