#!/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/zyxwvutsrqponmlkjihgfedcba/;
				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 $@;