#!/usr/bin/perl
# Example code from  'perldoc -f open' 
#  
#  Redirect standard stream STDERR to a buffer and then
#   restore the standard stream 
#  With extension of nested redirections (which does not work!)  


###############################################################
package  WrapSTDERR; 
use strict;
use warnings;
use Carp;
use Data::Dumper;

sub capture;
sub restore;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {
        'buffer' => "", 
        'STREAM' => undef,
        'state'  => 'closed'
    };
    $self = bless $self, $class;	
    return $self;
}

sub DESTROY {
    my $self = shift;
    if ($self->{'state'} eq 'bound') {
        $self->restore();
    }
}

sub capture {
    my $self = shift;

    if ($self->{'state'} eq 'bound') {
        confess "Cannot bind STDERR again while it is bound,"
         ." use another wrapper object.";
    }
	
    # duplicate STDERR filehandle in $self->{'STREAM'}
    open(  $self->{'STREAM'}, ">&STDERR") ## no critic
        or die "Failed to save STDERR";

## WHAT TO DO HERE INSTEAD?
## How to save the previous stream for restore?
## Can I find out whether STDERR is already bound to a string buffer 
#   and save the ref to the buffer for rebinding on restore?

    $self->{'STREAM'}->print(""); # get rid of silly warning message
    close STDERR; # required for open  
    open( STDERR, '>', \$self->{'buffer'} ) or die "Cannot open STDERR: $!";
    STDERR->autoflush();
    $self->{'state'} = 'bound';
    return $self; # for chaining with new
}

sub restore {
    my $self = shift;
    if (! $self->{'state'} eq 'bound') {
        confess "Cannot restore STDERR when it is not bound.";
    }
    
    close STDERR; # remove binding to string buffer
    # rebind STDERR to previous handle
    open( STDERR, ">&", $self->{'STREAM'} )   
        or die "Failed to restore STDERR";

## WHAT TO DO ABOVE INSTEAD?
## Can I get the buffer to rebind from the STDERR handle in capture and save it?
## How to restore the binding to the buffer of the previous stream (if there is one)?

    $self->{'STREAM'}->close();
    $self->{'STREAM'}= undef;
    $self->{'state'} = 'closed';
    my $data = $self->{'buffer'};   
    return $data;
}
1;
######################################################################

package main;

sub handleInner {
	print "INNER BEFORE CAPTURE\n";
	my $innerCapture = WrapSTDERR->new()->capture();
	print STDERR "FIRST CAPTURE\n";  # to innerbuffer, works
	my $buffer = $innerCapture->restore();
	chomp $buffer;
	print "INNER AFTER RESTORE\n";
	print STDERR "inner past restore\n";  
        # above goes to console or the outerbuffer, 
        #   it fails for outerbuffer when called from handleOuter
	print "BUFFER (inner): \n#>>$buffer<<\n";
}


sub handleOuter {
	print "OUTER BEFORE CAPTURE\n";
	my $outerCapture = WrapSTDERR->new()->capture();
	print STDERR "OUTER BEFORE CALL\n"; # to outerbuffer
	handleInner();
	print STDERR "outer past call\n"; # to outerbuffer
	#    (It does not go to the buffer in $outerCapture,
        #     which is the topic of this question)
	my $buffer = $outerCapture->restore();
	chomp $buffer;
	print "OUTER PAST RESTORE\n";
	print "BUFFER (outer): \n#>>$buffer<<\n";
}

handleInner();
#prints this: 
# INNER BEFORE CAPTURE
# INNER AFTER RESTORE
# INNER PAST RESTORE
# BUFFER (inner):
#>>FIRST CAPTURE<<

print "####################\n";

handleOuter();
#prints this:
# OUTER BEFORE CAPTURE
# INNER BEFORE CAPTURE
# INNER AFTER RESTORE
# BUFFER (inner): >>FIRST CAPTURE<<
# OUTER AFTER RESTORE
# BUFFER (outer):
#>>OUTER BEFORE CALL<<

# Above line is not correct.  

#handleOuter() is expected to produce:
# OUTER BEFORE CAPTURE
# INNER BEFORE CAPTURE
# INNER AFTER RESTORE
# BUFFER (inner): >>FIRST CAPTURE<<
# OUTER AFTER RESTORE
# BUFFER (outer):
#>>OUTER BEFORE CALL\ninner past restore\nouter past call<<