1package IO::c55Capture;
2
3use IO::Handle;
4
5=head1 Name
6
7t/lib/IO::c55Capture - a wafer-thin test support package
8
9=head1 Why!?
10
11Compatibility with 5.5.3 and no external dependencies.
12
13=head1 Usage
14
15Works with a global filehandle:
16
17    # set a spool to write to
18    tie local *STDOUT, 'IO::c55Capture';
19    ...
20    # clear and retrieve buffer list
21    my @spooled = tied(*STDOUT)->dump();
22
23Or, a lexical (and autocreated) filehandle:
24
25    my $capture = IO::c55Capture->new_handle;
26    ...
27    my @output = tied($$capture)->dump;
28
29Note the '$$' dereference.
30
31=cut
32
33# XXX actually returns an IO::Handle :-/
34sub new_handle {
35    my $class  = shift;
36    my $handle = IO::Handle->new;
37    tie $$handle, $class;
38    return ($handle);
39}
40
41sub TIEHANDLE {
42    return bless [], __PACKAGE__;
43}
44
45sub PRINT {
46    my $self = shift;
47
48    push @$self, @_;
49}
50
51sub PRINTF {
52    my $self = shift;
53    push @$self, sprintf(@_);
54}
55
56sub dump {
57    my $self = shift;
58    my @got  = @$self;
59    @$self = ();
60    return @got;
61}
62
63package util;
64
65use IO::File;
66
67# mostly stolen from Module::Build MBTest.pm
68
69{    # backwards compatible temp filename recipe adapted from perlfaq
70    my $tmp_count = 0;
71    my $tmp_base_name = sprintf( "%d-%d", $$, time() );
72
73    sub temp_file_name {
74        sprintf( "%s-%04d", $tmp_base_name, ++$tmp_count );
75    }
76}
77########################################################################
78
79sub save_handle {
80    my ( $handle, $subr ) = @_;
81    my $outfile = temp_file_name();
82
83    local *SAVEOUT;
84    open SAVEOUT, ">&" . fileno($handle)
85      or die "Can't save output handle: $!";
86    open $handle, "> $outfile" or die "Can't create $outfile: $!";
87
88    eval { $subr->() };
89    my $err = $@;
90    open $handle, ">&SAVEOUT" or die "Can't restore output: $!";
91
92    my $ret = slurp($outfile);
93    1 while unlink $outfile;
94    $err and die $err;
95    return $ret;
96}
97
98sub stdout_of { save_handle( \*STDOUT, @_ ) }
99sub stderr_of { save_handle( \*STDERR, @_ ) }
100
101sub stdout_stderr_of {
102    my $subr = shift;
103    my ( $stdout, $stderr );
104    $stdout = stdout_of(
105        sub {
106            $stderr = stderr_of($subr);
107        }
108    );
109    return ( $stdout, $stderr );
110}
111
112sub slurp {
113    my $fh = IO::File->new( $_[0] ) or die "Can't open $_[0]: $!";
114    local $/;
115    return scalar <$fh>;
116}
117
1181;
119
120# vim:ts=4:sw=4:et:sta
121