package IO::Capture;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(open_s close_s);

BEGIN {
	if ($] < 5.008) {
		*open_s = \&open_s6;
		*close_s = \&close_s6;
	} else {
		*open_s = \&open_s8;
		*close_s = \&close_s8;
	}
}

# this works for $] >= 5.008
# because it uses in-core files

my $memory;

sub open_s8 {
	my $glob = shift;
	$memory = '';
	open $glob, ">", \$memory or die $!;
}

sub close_s8 {
	my $glob = shift;
	close $glob or die $!;
	return $memory;
}

# this works anywhere
# but is uses a temp file

my $tmp_fn = 't/0.tmp';

sub slurp_tmp {
	local $/;
	open TMP, $tmp_fn or die $!;
	my $tmp = <TMP>;
	close TMP or die $!;
	return $tmp
}

sub open_s6 {
	my $glob = shift;
	open $glob, ">$tmp_fn" or die;
}

sub close_s6 {
	my $glob = shift;
	close $glob or die $!;
	my $memory = slurp_tmp;
	unlink $tmp_fn or die $!;
	return $memory
}


1;

__END__

=head1 NAME

IO::Capture - Capture the output sent to a glob

=head1 SYNOPSIS

  use IO::Capture qw(open_s close_s);
  local *STDOUT; # localize STDOUT
  open_s *STDOUT;

  # print to STDOUT: output is saved

  my $out = close_s *STDOUT; # and returned here

=head1 DESCRIPTION

This is a very fragile code. This is for testing
warnings to STDERR in "t/001_dot.t".