I've tested this code in a very limited fashion (i.e., this script), but I want to know if anyone sees any caveats to this solution. Is it sound? Do you like it? What would you change?

The capture_streams() subroutine is the interesting part. The rest is the test script.

#!/usr/bin/perl

use strict;
use warnings;

use File::Temp 'tempfile';
use IO::String;
use Symbol;

sub capture_streams {
    my $in   = shift;
    my $out  = shift;
    my $code = shift;

    my $tie_in  = UNIVERSAL::can($in,  'TIEHANDLE');
    my $tie_out = UNIVERSAL::can($out, 'TIEHANDLE');

    my ($save_in, $save_out);
    my ($save_in_fd, $save_out_fd);

    # Save/capture STDIN
    if ($tie_in) {
        $save_in = tied *STDIN;
        tie *STDIN, $in;
    } else {
        if (tied *STDIN) {
            $save_in = tied *STDIN;
            no warnings 'untie';
            untie *STDIN;
        }
        $save_in_fd = gensym;
        open($save_in_fd, '<&STDIN');
        open(STDIN, '<&='.fileno($in));
    }

    # Save/capture STDOUT
    if ($tie_out) {
        $save_out = tied *STDOUT;
        tie *STDOUT, $out;
    } else {
        if (tied *STDOUT) {
            $save_out = tied *STDOUT;
            no warnings 'untie';
            untie *STDOUT;
        }
        $save_out_fd = gensym;
        open($save_out_fd, '>&STDOUT');
        open(STDOUT, '>&='.fileno($out));
    }

    # Run code within captured handles
    my $result;
    if (wantarray) {
        my @array = $code->(@_);
        $result = \@array;
    } else {
        $result = $code->(@_);
    }

    # Restore STDOUT
    if ($tie_out) {
        if (defined $save_out) {
            tie *STDOUT, $save_out;
        } else {
            no warnings 'untie';
            untie *STDOUT;
        }
    } else {
        open(STDOUT, '>&='.fileno($save_out_fd));
        close($save_out_fd);
        
        if (defined $save_out) {
            tie *STDOUT, $save_out;
        }
    }

    # Restore STDIN
    if ($tie_in) {
        if (defined $save_in) {
            tie *STDIN, $save_in;
        } else {
            no warnings 'untie';
            untie *STDIN;
        }
    } else {
        open(STDIN, '<&='.fileno($save_in_fd));
        close($save_in_fd);

        if (defined $save_in) {
            tie *STDIN, $save_in;
        }
    }

    return wantarray ? @$result : $result;
}

sub test_it {
    my ($in, $out, $data) = @_;

    print $in $data;
    seek $in, 0, 0;

    capture_streams($in, $out, sub {
        while (<STDIN>) {
            tr/abcdefghijklmnopqrstuvwxyz/zyxwvutsrqponmlkjihgfedcba/;
            print $_;
        }
    });

    seek $out, 0, 0;

    while (<$out>) {
        print;
    }
}

sub nested_test_it {
    my ($in, $in2, $out, $out2, $data) = @_;

    print $in $data;
    seek $in, 0, 0;

    capture_streams($in, $out, sub {
        while (<STDIN>) {
            print $in2 $_;
        }
        seek $in2, 0, 0;

        capture_streams($in2, $out2, sub {
            while (<STDIN>) {
                tr/abcdefghijklmnopqrstuvwxyz/zyxwvutsrqponmlkjihgfedc
+ba/;
                print $_;
            }
        });

        seek $out2, 0, 0;
        while (<$out2>) {
            print;
        }
    });

    seek $out, 0, 0;

    while (<$out>) {
        print;
    }
}    

my $data = join '', <STDIN>;

eval {
print "Test 0\n";
print '=' x 70, "\n";
test_it(IO::String->new, IO::String->new, $data);
}; print STDERR $@ if $@;

eval {
print "\nTest 1\n";
print '=' x 70, "\n";
test_it(scalar(tempfile), scalar(tempfile), $data);
}; print STDERR $@ if $@;

eval {
print "\nTest 2\n";
print '=' x 70, "\n";
nested_test_it(
    IO::String->new, IO::String->new, 
    IO::String->new, IO::String->new,
    $data);
}; print STDERR $@ if $@;

eval {
print "\nTest 3\n";
print '=' x 70, "\n";
nested_test_it(
    scalar(tempfile), IO::String->new, 
    IO::String->new, scalar(tempfile),
    $data);
}; print STDERR $@ if $@;

eval {
print "\nTest 4\n";
print '=' x 70, "\n";
nested_test_it(
    IO::String->new, scalar(tempfile),
    scalar(tempfile), IO::String->new,
    $data);
}; print STDERR $@ if $@;

eval {
print "\nTest 5\n";
print '=' x 70, "\n";
nested_test_it(
    scalar(tempfile), scalar(tempfile),
    scalar(tempfile), scalar(tempfile),
    $data);
}; print STDERR $@ if $@;
[download]

Thanks,
Sterling