open(FOO,">/temp/foo") || die $!;
sub foo { local *STDOUT=*FOO; print "foo"; } #yes, this is supposedly 
+to STDOUT
foo;
close(FOO);
[download]

*FOO=*STDOUT; #Save it somehow
open(STDOUT,">>outputfile") || die $!;
sub foo { print "foo bar"; }
foo;
close(STDOUT);
*STDOUT=*FOO;
[download]

use IO::Scalar;

tie *STDOUT, 'IO::Scalar', \my $out;
function_which_prints_to_stdout();
untie *STDOUT;

# the output is stored in $out
[download]

--
Tatsuhiko Miyagawa
miyagawa@cpan.org

=head1 NAME

Catch - catch output of function

=head1 SYNOPSIS

 use Catch;

 ($output, $error, @retval)=catchit(&foofunc, @args);
 ($output, $error, $retval)=catchit(&foofunc, @args);

=head1 DESCRIPTION

The catchit() function runs a specified function, with the given argum
+ents
and captures the STDOUT and STDERR emissions from that function.

This is useful when you've got to call a function which prints data, b
+ut
the data needs to be "cooked" before display or needs to be thrown awa
+y
altogether.  This is especially useful for functions whose code you ha
+ve
no control over, and would rather not copy the function or start all o
+ver.

The function is run in an eval {}, so that STDERR and STDOUT will be f
+ixed
even if the function dies.  The die() is re-performed after the file
handles are cleaned up.

=head1 RETURNS

=over 4

=item &foofunc

The function you want run and captured.

=item @args

The arguments to that function.

=item $output

The captured STDOUT of the function.  The output isn't cooked in any w
+ay.

=item $error

The captured STDERR of the function.

=item @retval, $retval

The return values of the function.  

=back

=head1 EXAMPLE

 use Catch;

 sub messy {
        my(@args)=@_;
        select(STDOUT);
        print "Here's some standard output.  Blah, blah: @args";
        warn "Danger Will Robinson!";
        return(1);
}

($output, $errors, $retval)=catchit(\&messy, "Print me!");

=head1 BUGS

=over 4

=item *

If the function called returns a list, and you use a scalar to receive
them, only the first value is put into the scalar.  Presumably, since 
+you
know what the API for this function is anyway, use the right type: an
array or a scalar.

=item *

Doesn't take kindly to functions that move/re-open STDOUT and STDERR o
+r
that play with the __WARN__ handler.


=item *

Not really a bug, but calling programs in backticks (system, pipes, et
+c..)
and XS programs which output directly to stderr/stdout bypass this
mechanism completely.  That's not what this is for.

=back

=head1 AUTHOR

Clinton Pierce (F<clintp@geeksalad.org>)

All rights reserved.  This program is free software; you can redistrib
+ute
it and/or modify it under the same terms as Perl itself.

=cut

package Catch;
require 5.005;
use strict;
use Carp;
use vars qw(@EXPORT $VERSION @ISA $AUTOLOAD %UNK *STDIN *STDOUT);

use Exporter;
@ISA=qw(Exporter);

@EXPORT=qw( catchit );
$VERSION=1.00;

%UNK=(
        READ => \&read_warning,
        READLINE => \&read_warning,
        GETC => \&read_warning,
        CLOSE   => sub { 1;},
        DESTROY => sub { 1;},
);

sub catchit {
        my($coderef, @args)=@_;

        open(SAVEOUT, ">&STDOUT") || warn "Cannot save STDOUT: $!\n";
        open(SAVEERR, ">&STDERR") || warn "Cannot save STDERR: $!\n";
        my($out,$err)=("","");  
        
        my $cap_out=tie(*STDOUT, 'Catch', \$out);
        my $cap_err=tie(*STDERR, 'Catch', \$err);
        my @retval;


        # warn() doesn't seem to print to STDERR through Perl.  
    # Catch that manually.
        my($old_warn)=$SIG{__WARN__};

        $SIG{__WARN__}= sub {
                        print STDERR "@_"       
                };
        eval {
                @retval=&$coderef(@args);
        };
        $SIG{__WARN__}=$old_warn;

        undef $cap_out; # To silence "inner references" warnings
        undef $cap_err; # as documented in "perltie"
        untie(*STDOUT);
        untie(*STDERR);
        open(STDOUT, ">&SAVEOUT") || warn "Cannot restore STDOUT: $!\n
+";
        open(STDERR, ">&SAVEERR") || warn "Cannot restore STDERR: $!\n
+";
        if ($@) {
                die "$@";
        }
        return($out, $err, @retval);
}

sub TIEHANDLE {
        my($class,$vref)=@_;
        my $self={
                data=> $vref
        };
        bless($self, $class);
        return($self);

}
sub WRITE {
        my($self)=shift;
        
        my($buf, $len, $offset)=@_;
        ${ $self->{data} }.=$buf;
        return 1;
}
sub PRINT {
        my($self)=shift;
        ${ $self->{data} }.=join('', @_);
        return 1;
}
sub PRINTF {
        my($self)=shift;
        my $fmt=shift;
        ${ $self->{data}}.=sprintf($fmt, @_);
        return 1;
}
sub AUTOLOAD {
        my($self)=@_;
        my $attr=$AUTOLOAD;
        $AUTOLOAD=~s/.*:://;
        if (exists $UNK{$AUTOLOAD}) {
                &{ $UNK{$AUTOLOAD} };
        }
}
sub read_warning {
        carp "Cannot read from specified filehandle.";
}
1;
[download]

This is what local is for IMO. I hear a lot of people groan/make fun of local but it's superb for this usage. If you declare local anything and assign to it within a block, it returns to its former global assignment after the block exits. The assignment holds through the entire calling stack within a block.

use IO::File;

sub stdout_func
{
    print "Hello world.\n";
}

stdout_func();    # To STDOUT

# To /tmp/foo.out
{
    my $fh = IO::File->new(">/tmp/foo.out");
    local *STDOUT = $fh;
    stdout_func();
}

# Walla -- back to STDOUT
stdout_func();    # To STDOUT

I forgot to mention that I want STDERR too to be directed to the same file, can I dup it inside the local block?

Hotshot