CGI::MxScreen::Tie::Buffered_Output - Buferring of screen outputs

 # Not meant to be used directly

# -*- Mode: perl -*-
#
# $Id: Buffered_Output.pm,v 0.1 2001/04/22 17:57:04 ram Exp $
#
#  Copyright (c) 1998-2001, Raphael Manfredi
#  Copyright (c) 2000-2001, Christophe Dehaudt
#  
#  You may redistribute only under the terms of the Artistic License,
#  as specified in the README file that comes with the distribution.
#
# HISTORY
# $Log: Buffered_Output.pm,v $
# Revision 0.1  2001/04/22 17:57:04  ram
# Baseline for first Alpha release.
#
# $EndLog$
#

use strict;

package CGI::MxScreen::Tie::Buffered_Output;

require Tie::Handle;
require CGI::MxScreen::Tie::Sinkable;

use vars qw(@ISA);
@ISA = qw(Tie::Handle CGI::MxScreen::Tie::Sinkable);

use Carp::Datum;
use Log::Agent;
use Symbol;

use constant HEADER			=> 0;
use constant BODY			=> 1;
use constant FILE_HANDLE	=> 2;
use constant WRITE_FIELD	=> 3;

#
# (TIEHANDLE)
#
# Initial tieing.
#
sub TIEHANDLE {
	DFEATURE my $f_;
	my $self = bless [], shift;

	my $fh = gensym();
	open($fh, ">&STDOUT") || logdie "can't save STDOUT: $!";
	open(STDOUT, ">/dev/null") || logdie "can't reopen STDOUT: $!";

	$self->[HEADER]      = ' ' x 10_000;		# pre-extent
	$self->[HEADER]      = '';
	$self->[BODY]        = ' ' x 100_000;		# pre-extent
	$self->[BODY]        = '';
	$self->[FILE_HANDLE] = $fh;					# saved STDOUT
	$self->[WRITE_FIELD] = HEADER;				# start to write into header

	return DVAL $self;
}

sub header	{ $_[0]->[HEADER] }
sub body	{ $_[0]->[BODY] }
sub fh		{ $_[0]->[FILE_HANDLE] }

#
# ->reset
#
# Reset state to "emptyness", clearing both BODY and HEADER and getting
# ready to get new data.
#
# Returns the length of BODY data we discarded.
#
sub reset {
	DFEATURE my $f_;
	my $self = shift;
	my $discarded = length $self->[BODY];

	$self->[HEADER]      = '';
	$self->[BODY]        = '';
	$self->[WRITE_FIELD] = HEADER;				# start to write into header

	return DVAL $discarded;
}

#
# ->header_ok
#
# Headers has been written.
# Further output is buffered separately.
#
sub header_ok {
	DFEATURE my $f_;
	my $self = shift;
	logcroak "called header_ok() more than once"
		unless $self->[WRITE_FIELD] == HEADER;
	$self->[WRITE_FIELD] = BODY;
	return DVOID;
}

#
# ->discard_all			-- redefined
#
# Discard all buffered data.
#
sub discard_all {
	DFEATURE my $f_;
	my $self = shift;
	$self->[HEADER] = $self->[BODY] = '';
	return DVOID;
}

#
# ->print_all
#
# Print all buffered data sofar to the original STDOUT.
# The supplied $str is printed between HEADER and BODY.
#
sub print_all {
	DFEATURE my $f_;
	my $self = shift;
	my $fh = $self->fh;
	logcroak "$self already closed" unless defined fileno($fh);
	local $\ = undef;
	print $fh $self->[HEADER];
	print $fh $_[0];
	print $fh $self->[BODY];
	$self->discard_all;
	return DVOID;
}

#
# (WRITE)
#
# Intercept writes
#
sub WRITE {
	DFEATURE my $f_;
	my $self = shift;
	my ($buf, $len, $offset) = @_;
	my $field = $self->[WRITE_FIELD];
	$self->[$field] .= substr($buf, $offset, $len);
	return DVOID;
}

#
# (CLOSE)
#
# Restore orginal STDOUT, and flush buffers
# NB: unties STDOUT as a side effect.
#
sub CLOSE {
	DFEATURE my $f_;
	my $self = shift;
	my $fh = $self->fh;
	logdie "$self already closed" unless defined fileno($fh);
	local $\ = undef;
	print $fh $self->[HEADER];
	print $fh $self->[BODY];
	untie *STDOUT;
	open(STDOUT, ">&=" . fileno($fh)) || logdie "can't restore STDOUT: $!";
	close $fh;
	$self->[HEADER] = $self->[BODY] = '';
	return DVOID;
}

#
# (DESTROY)
#
# Destructor: ensure buffers are flushed if not already done
#
sub DESTROY {
	DFEATURE my $f_;
	my $self = shift;
	my $fh = $self->fh;
	return DVOID unless defined fileno($fh);
	$self->CLOSE;
	return DVOID;
}

1;