#
# Гарантирует, что вывод через print можно безопасно направить в браузер.
# То есть, буферизует его, следит за заголовками, а также за тем, чтобы
# заголовок Content-type всегда выводился перед текстом документа.
# Помимо всего этого, следит за ошибками, возникающими в скрипте, и 
# перенаправляет их в браузер (в виде комментариев или видимого текста).
# Также позволяет выборочно перехватывать выходной поток скрипта для
# последующей обработки: $text = grab { print "Hello" }.
# В общем, полная эмуляция поведения PHP.
#
# 23.08.2003
#   Now CGI::WebOut is fully tie-safe: if somebody ties STDOUT before
#   including module, all works correctly and transparently.
#
package CGI::WebOut;
our $VERSION = "2.10";

use strict;
use Exporter; our @ISA=qw(Exporter);
our @EXPORT=qw(
	ER_NoErr
	ER_Err2Browser 
	ER_Err2Comment 
	ER_Err2Plain
	ErrorReporting
	grab
	echo  
	SetAutoflush 
	NoAutoflush 
	UseAutoflush 
	Header
	HeadersSent
	Redirect
	ExternRedirect
	NoCache
	Flush
	try catch warnings throw
);


##
## Константы
##
sub ER_NoErr { 0 }                # Запретить вывод об ошибках
sub ER_Err2Browser { 1 }          # Ошибки и предупреждения направить в браузер
sub ER_Err2Comment { 2 }          # То же, но в виде <!--...-->-комментариев
sub ER_Err2Plain { 3 }            # То же, но в виде plain-текста


##
## Внутренние переменные
##
our $DEBUG = undef;              # отладочный режим - задает имя файла.
our $UseAutoflush = 1;           # Режим автосброса включен
our $HeadersSent = 0;            # признак: заголовки уже посланы
our @Headers = ();               # заголовки ответа
our $NoCached = 0;               # документ не кэшируется
our $Redirected = 0;             # была переадресация
our $ErrorReporting = 1;         # вывод ошибок в браузер включен
our @Errors = ();                # здесь накапливаются ошибки
our @Warns = ();                 # предупреждения

# К сожалению, вместо того, чтобы хранить текущий и корневой ОБЪЕКТЫ вывода, 
# приходится хранить лишь СТРОКОВЫЕ БУФЕРА. Дело в том, что хранение объекта
# увеличивает его счетчик ссылок, а значит, если в программе встретится:
#   $b = new CGI::WebOut();
#   ...
#   $b = undef;
# то деструктор для $b вызван не будет (т.к. ссылка на него записана в $CurObj).
# Если же хранить в объектах ссылки на строковые буфера, а ссылки на сами
# объекты дополнительно НЕ хранить, деструктор вызывается, как надо.
#
# Это все также означает, что получить в этом модуле ссылку на текущий 
# ОБЪЕКТ ВЫВОДА нельзя никак. Можно лишь получить ссылку на его буфер.
# Таким образом, echo всегда работает со строковым буфером, но НЕ объектом.
our $rRootBuf = \(my $s="");     # главный буфер вывода
our $rCurBuf;                    # текущий буфер вывода

#
# Algorythm is:
# 1. Tie STDOUT to newly created CGI::WebOut::Tie.
# 2. Constructor CGI::WebOut::Tie->RIEHANDLE creates new objecc CGI::WebOut
#    and stores its reference in its property. It is IMPORTANT that there 
#    are NO other reserences to this object stored in some other place.
# 3. That's why, when STDOUT is untied (in END or during global destruction)
#    CGI::WebOut object is destroyed too.
# 4. In destructor CGI::WebOut->DESTROY works code: if this object is the 
#    first (root), Flush() is called and errors are printed.
#


# Synopsis: use CGI::WebOut($restart=0)
# При подключении проверяет связывание STDOUT и, если свящанности нет или
# она поменялась, устанавливает ее на себя.
#
# Вниманию пользователей FastCGI: import работает не так, как хотелось бы. 
# Например, если в цикле с двумя итерациями написать use CGI::WebOut, то 
# реально import будет вызван только 1 раз. Зато если дважды написать эту же 
# команду, то import вызовется дважды. Гарантированно import запускается 
# следующей конструкцией: eval("use CGI::WebOut(1)"). Ее рекомендуется 
# вставлять внутрь цикла обработки подключений FastCGI.
#
# Если параметр $restart равен true, то все происходит так, будто бы 
# заголовки ответа еще никогда не посылались.


##
## Общедоступные статические функции. 
##

# void retieSTDOUT($restart=false)
# Запоминаем старый STDOUT (длинное название - специально, чтобы не 
# злоупотребляли!) и устанавливает свой перехватчик на STDOUT. В случае, 
# если свой перехватчик уже установлен, ничего не делает. 
my $numReties;
sub retieSTDOUT
{	my ($needRestart) = @_;
	$needRestart ||= !$numReties++;
	# Handle all warnings and errors.
	$SIG{__WARN__} = sub { &Warning(($_[0] !~ /^\w+:/ ? "Warning: " : "").shift) };
	$SIG{__DIE__} = sub { return if ref $_[0]; &Warning(($_[0] !~ /^\w+:/ ? "Fatal: " : "").shift) };
	# Если начат новый скрипт, сбрасываем признак отсылки заголовков.
	if ($needRestart) {
		$HeadersSent = $Redirected = $NoCached = 0;
		@Headers = ();
		$$rRootBuf = '';
	}
	# Если ничего не изменилось, выходим
	return if tied(*STDOUT) && ref tied(*STDOUT) eq __PACKAGE__."::Tie";
	tie(*STDOUT, __PACKAGE__."::Tie", \*STDOUT, tied(*STDOUT));
}


# Проверяет, используется ли библиотека Web-скриптом или обычным
sub IsWebMode() { 
	return $ENV{SCRIPT_NAME}? 1 : 0 
}


# Посланы ли заголовки?
sub HeadersSent { 
	return $HeadersSent;
}


# static int echo(...)
# Выводит список агрументов в ТЕКУЩИЙ активный буфер. Если этот 
# буфер направлен непосредственно в браузер, вызывает Flush().
# Возвращает число выведенных символов.
sub echo {
	# В случае наличия undef-значений в списке делаем то же,
	# что и print.
	if(grep {!defined $_} @_) {
		# Если модуля нет - не страшно, просто ничего не печатается.
		eval { require Carp } 
			and Carp::carp("Use of uninitialized value in print"); 
	}
	my $txt = join("", map { defined $_? $_:"" } @_); 
	return if $txt eq "";
	$$rCurBuf .= $txt;
	Flush() if $UseAutoflush && $rCurBuf == $rRootBuf;
	return length($txt);
}


# Перехват выходного потока. Использование:
# $grabbed = grab { 
#     print 'Hello!' 
# } catch {
#     die "An error occurred while grabbing the output: $@";
# };
# или то же, но без catch: 
# $grabbed = grab { print 'Hello!' };
sub grab(&@)
{	my ($func, $catch)=@_;
	my $Buf = CGI::WebOut->new; 
	$@ = undef; eval { &$func() };
	if ($@ && $catch) { chomp($@); local $_ = $@; &$catch; }
	return $Buf->buf;
}


# static Header($header)
# Устанавливает заголовок ответа.
sub Header($)
{	my ($head)=@_;
	if ($HeadersSent) {
		eval { require Carp } 
			and Carp::carp("Oops... Header('$head') called after content had been sent to browser!\n"); 
		return undef; 
	}
	push(@Headers, $head);
	return 1;
}


# Сбрасывает содержимое главного буфера в браузер.
sub Flush() {	
	# Отключаем внутреннюю буферизацию Perl-а
	local $| = 1;	
	# Если заголовки еще не отосланы, отослать их
	if (!$HeadersSent && IsWebMode()) {
		my $ContType="text/html";
		unshift(@Headers,"X-Powered-By: CGI::WebOut v$VERSION (http://www.dklab.ru/chicken/4.html) by Dmitry Koteroff, (C) 2000-2004.");
		# Ищем Content-type, чтобы потом отправить его в конце
		for (my $i=0; $i<@Headers; $i++) {
			if ($Headers[$i]=~/^content-type: *(.*)$/i) {
				$ContType = $1; splice(@Headers, $i, 1); $i--;
				next;
			}
			if ($Headers[$i]=~m/^location: /i) {
				$Redirected = 1;
			}
		}
		push(@Headers, "Content-type: $ContType");
		my $headers = join("\n",@Headers)."\n\n";
		if (!$Redirected) {
			# Prepend the output buffer with headers data.
			# So we output the buffer and headers in ONE print call (it is 
			# more transparent for calling code if it ties STDOUT by himself).
			$$rRootBuf = $headers.$$rRootBuf;
		} else {
			# Only headers should be sent. 
			_RealPrint($headers);
		}
		$HeadersSent = 1;
	}
	# Отправить буфер и очистить его
	_Debug("Flush: len=%d", length($$rRootBuf));
	if (!$Redirected) { 
		_RealPrint($$rRootBuf);
	}
	$$rRootBuf = "";
	return 1;
}


# constructor new($refToNewBuf=undef)
# Делает текущим новый буфер вывода.
sub new
{	my ($class, $rBuf)=@_;
	$rBuf = \(my $b="") if !defined $rBuf;
	my $this = bless {
		rPrevBuf => $rCurBuf,
		rCurBuf  => $rBuf,
	}, $class;
	$rCurBuf = $rBuf;
	_Debug("[%s] New: prevSt=%s, curSt=%s", $this, $this->{rPrevBuf}, $this->{rCurBuf});
	return $this;
}


# Восстанавливает предыдущий активный объект вывода
sub DESTROY
{	my ($this)=@_;
	_Debug("[%s] DESTROY: prevSt=%s, curSt=%s", $this, $this->{rPrevBuf}, $this->{rCurBuf});

	# Если это последний объект, то выполняем действия, которые нужно обязательно
	# закончить к моменту завершения программы. То есть, этот участок кода выполняется
	# тогда и только тогда, когда вызывается DESTROY для объекта, связанного с
	# STDOUT, то есть перед самым завершением программы (по ошибке или нет - не важно).
	# Все эти сложности нужны только потому, что, оказывается, в Perl нельзя
	# объявить функцию, которая будет гарантировано вызываться в конце, особенно при
	# фатальной ошибке... Однако можно создать некоторый объект, который при уничтожении 
	# вызовет свой деструктор. Таким объектом для нас будет объект, связанный
	# с STDOUT. Нам это жизненно необходимо, потому что нужно любой ценой вывести 
	# заголовки и, возможно, сообщения о возникших ошибках. Это, собственно, и 
	# делается здесь.
	if ($rCurBuf == $rRootBuf) {
		# Вызываемая отсюда функция НЕ МОЖЕТ использовать print и STDOUT, потому что
		# в момент прохождения этой точки STDOUT ни к чему не "привязан", но
		# Perl-у кажется, что привязан, поэтому генерируется GP Fault.
		&__PrintAllErrors() if @Errors;
		Flush();
		return;
	}
	$rCurBuf = $this->{rPrevBuf};
}


# string method buf()
# Вызывается для получения данных из буфера вывода.
sub buf { 
	return ${$_[0]->{rCurBuf}};
}



##
## Служебные функции и методы.
##

# constructor _newRoot()
# Creates the new ROOT (!!!) buffer. Called internally while tying STDOUT.
sub _newRoot {
	$$rRootBuf = "";
	$rCurBuf = undef;
	goto &new;
}


# Package import.
sub import {
	my ($pkg, $needRestart)=@_;
	retieSTDOUT($needRestart);
	goto &Exporter::import;
}


# Деструктор пакета. Следит за тем, чтобы все объекты были удалены в 
# правильном порядке. Вызывается ДО фазы "global destruction", что 
# нам и нужно. Правда, есть сведения, что иногда END НЕ вызывается
# (в случае каких-то ошибок), однако и в этом случае все будет работать
# корректно (см. _RealPrint).
sub END {
	return if !tied(*STDOUT) || ref tied(*STDOUT) ne __PACKAGE__."::Tie";
	CGI::WebOut::_Debug("END");
	untie(*STDOUT);
}


# static _RealPrint()
# Prints the data to "native" STDOUT handler.
sub _RealPrint {	
	my $obj = tied(*STDOUT);
	_Debug("_RealPrint: STDOUT tied: %s", $obj);
	my $txt = join("", @_);
	return if $txt eq "";
	if ($obj) { 
		return $obj->parentPrint(@_) 
	} else {
		# Sometimes, during global destruction, STDOUT is already untied
		# but print still does not work. I don't know, why. This workaround
		# works always.
		open(local *H, ">&STDOUT");
		return print H @_;
	}
}


# Для отладки - выводит сообщение в файл
my $opened;
sub _Debug {	
	return if !$DEBUG;
	my ($msg, @args) = @_;

	# Detect "global destruction" stage.
	my $gd = '';
	{
		local $SIG{__WARN__} = sub { $gd .= $_[0] };
		warn("test");
		$gd =~ s/^.*? at \s+ .*? \s+ line \s+ \d+ \s+//sx;
		$gd =~ s/^\s+|[\s.]+$//sg;
		$gd = undef if $gd !~ /global\s*destruction/i;
	}
	local $^W;
	open(local *F, ($opened++? ">>" : ">").$DEBUG); 
	print F sprintf($msg, map { defined $_? $_ : "undef" } @args) . ($gd? "($gd)" : "")."\n";
}


##
## Для перехвата вывода print-а
##

{{{
##
## This class is used to tie some Perl variable to specified $object
## WITHOUT calling TIE* method of ref($object). Unfortunately Perl
## does not support 
##   tied(thing) = something;
## construction. Instead of this use:
##   tie(thing, "CGI::WebOut::TieMediator", something).
## See tieobj() below.
##
package CGI::WebOut::TieMediator;
#sub TIESCALAR { return $_[1] }
#sub TIEARRAY  { return $_[1] }
#sub TIEHASH   { return $_[1] }
sub TIEHANDLE { return $_[1] }
}}}


{{{
##
## This class is used to tie objects to filehandle.
## Synopsis:
##   tie(*STDOUT, "CGI::WebOut::Tie", \*STDOUT, tied(*STDOUT));
## All the parent methods is virtually inherited. So you
## may call print(*FH, ...), close(*FH, ...) etc.
## All the output is redirected to current CGI::WebOut object.
## This class is used internally by the main module.
##
package CGI::WebOut::Tie;

# The same as tie(), but ties existed object to the handle.
sub tieobj { 
	return tie($_[0], "CGI::WebOut::TieMediator", $_[1]) 
}

## Fully overriden methods.
sub WRITE  { shift; return CGI::WebOut::echo(@_); }
sub PRINT  { shift; return CGI::WebOut::echo(@_); }
sub PRINTF { shift; return CGI::WebOut::echo(sprintf(@_)); }

# Creates the new tie. Saves the old object and handle reference.
# See synopsis above.
sub TIEHANDLE 
{	my ($cls, $handle, $prevObj) = @_;
	CGI::WebOut::_Debug("TIEHANDLE(%s, %s, %s)", $cls, $handle, $prevObj);
	return bless { 
		handle  => $handle,
		prevObj => $prevObj,
		outObj  => CGI::WebOut->_newRoot($rRootBuf),
	}, $cls;
}

sub DESTROY {
	CGI::WebOut::_Debug("[%s] DESTROY", $_[0]);
}

## Methods, inherited from parent.
sub CLOSE 
{	my ($this) = @_;
	CGI::WebOut::Flush();
	$this->parentCall(sub { close(*{$this->{handle}}) });
}
sub BINMODE 
{ 	my ($this) = @_;
	$this->parentCall(sub { binmode(*{$this->{handle}}) });
}

# Untie process is fully transparent for parent. For example, code:
#   tie(*STDOUT, "T1");
#   eval "use CGI::WebOut"; #***
#   print "OK!";
#   untie(*STDOUT);
# generates EXACTLY the same sequence of call to T1 class, as this 
# code without ***-marked line.
# Unfortunately we cannot retie CGI::WebOut::Tie back to the object
# in UNTIE() - when the sub finishes, Perl hardly remove tie. 
our $doNotUntie = 0;
sub UNTIE
{	my ($this, $nRef) = @_;
	return if $doNotUntie;
	my $handle = $this->{handle};
	CGI::WebOut::_Debug("UNTIE prev=%s, cur=%s", $this->{prevObj}, tied(*$handle));
	# Destroy output object BEFORE untie parent.
	$this->{outObj} = undef;
	# Untie parent object.
	if ($this->{prevObj}) {
		tieobj(*$handle, $this->{prevObj});
		$this->{prevObj} = undef; # release ref
		untie(*$handle); # call parent untie
		$this->{prevObj} = tied(*$handle);
	}
}

# void method parentPrint(...)
# Prints using parent print method.
sub parentPrint
{	my $this = shift;
	my $params = \@_;
	$this->parentCall(sub { print STDOUT @$params });
}

# void method parentCall($codeRef)
# Calls $codeRef in the context of object, previously tied to handle.
# After call context is switched back, as if nothing has happened.
# Returns the same that $codeRef had returned.
sub parentCall
{	my ($this, $sub) = @_;
	my ($handle, $obj) = ($this->{handle}, $this->{prevObj});
	my $save = tied(*$handle);
	if ($obj) {
		tieobj(*$handle, $obj) 
	} elsif ($save) {
		local $doNotUntie = 1;
		local $^W;
		untie(*$handle);
	}
	my @result = wantarray? $sub->() : scalar $sub->();
	if ($save) {
		tieobj(*$handle, $save);
	} elsif ($obj) {
		local $doNotUntie = 1;
		local $^W;
		untie(*$handle);
	}
	return wantarray? @result : $result[0];
}
}}}


# Since v2.0 AutoLoader is not used.
#use AutoLoader 'AUTOLOAD';
#return 1;
#__END__


# Использование try-catch-throw:
# try { 
#   код, который может вылететь по ошибке
#   или который генерирует исключение с помощью throw
# } catch {
#   имя исключения или сообщение об ошибке - в $_
# } warnings {
#   список произошедших ошибок и предупреждений в @_
# }
# Блоки catch и warnings выполняются в порядке их появления и могут отсутствовать.
sub try (&;@) 
{	my ($try,@Hand) = @_;
	# Мы НЕ можем использовать local для сохранения @Errors по следующей присине.
	# Если в &$try выведутся предупреждения, а потом будет вызван exit(),
	# то до конца try() управление так и не дойдет. Если бы мы использовали 
	# local, то эти предупреждения в @Errors потерялись бы. Так как используется
	# сохранение во временной переменной, предупреждения в @Errors останутся на 
	# месте и выведутся на экран.
	my @SvErrors = @Errors;
	# Запускаем try-блок
	my @Result = eval { &$try };
	# Управление попало сюда, если внутри кода не было вызова exit().
	# В противном случае происодит вылет из функции и из программы.
	# Получаем все возникшие предупреждения. Причем записываем их в
	# переменную типа local, чтобы эта переменныя была видна внутри 
	# warnings-функции (см. ниже).
	local @Warns = @Errors>@SvErrors? @Errors[@SvErrors..$#Errors] : ();
	# Восстанавливаем сообщения об ошибках
	@Errors = @SvErrors;
	# Запускаем обработчики в порядке их появления
	map { &$_() } @Hand;
	# Возвращаем значение, которое вернул try-блок
	return wantarray? @Result: $Result[0];
}

# Возвращает функцию-замыкание, которая вызывает тело catch-блока.
sub catch(&;@) 
{	my ($body, @Hand)=@_;
	return (sub { if($@) { chomp($@); local $_=$@; &$body($_) } }, @Hand);
}

# Возвращает функцию-замыкание, которая вызывает тело warnings-блока.
sub warnings(&;@) 
{	my ($body,@Hand)=@_;
	return (sub { &$body(@Warns) }, @Hand);
}

# Выбрасывает исключение.
sub throw($) { 
	die(ref($_[0])? $_[0] : "$_[0]\n") 
}


# bool SetAutoflush([bool $mode])
# Устанавливает режим сброса буфера echo: если $mode=1, то разрешает его автосброс после
# каждого вывода print или echo, иначе - запрещает (сброс должен производиться по Flush()).
# Возвращает предыдущий установленный режим автосброса.
sub SetAutoflush(;$)
{	my ($mode)=@_;
	my $old = $UseAutoflush;
	if (defined $mode) { $UseAutoflush = $mode; }
	return $old;
}

# bool NoAutoflush()
# Запрещает сбрасывать буфер после каждого echo.
# Возвращает предыдущий статус автосброса.
sub NoAutoflush() {
	return SetAutoflush(0);
}


# bool UseAutoflush()
# Разрашает сбрасывать буфер после каждого echo.
# Возвращает предыдущий статус автосброса.
sub UseAutoflush() {
	return SetAutoflush(1);
}


# Перенаправляет на другой URL (может быть внутренним редиректом)
sub Redirect($)
{	my ($url) = @_;
	$Redirected = Header("Location: $url");
	exit;
}


# Перенаправляет БРАУЗЕР на другой URL
sub ExternRedirect($)
{	my ($url) = @_;
	if ($url !~ /^\w+:/) {
		# Относительный адрес.
		if ($url !~ m{^/}) {
			my $sn = $ENV{SCRIPT_NAME};
			$sn =~ s{/+[^/]*$}{}sg;
			$url = "$sn/$url";
		}
		# Добавить имя хоста.
		$url = "http://$ENV{SERVER_NAME}$url";
	}
	$Redirected = Header("Location: $url");
	exit;
}


# Запрещает кэширование документа браузером
sub NoCache()
{	return 1 if $NoCached++;
	Header("Expires: Mon, 26 Jul 1997 05:00:00 GMT") or return undef;
	Header("Last-Modified: ".gmtime(time)." GMT") or return undef;
	Header("Cache-Control: no-cache, must-revalidate") or return undef;
	Header("Pragma: no-cache") or return undef;
	return 1;
}


# int ErrorReporting([int $level])
# Устанавливает режим вывода ошибок:
# 0 - ошибки не выводятся
# 1 - ошибки выводятся в браузер
# 2 - ошибки выводятся в браузер в виде комментариев
# Если параметр не задан, режим не меняется.
# Возвращает предыдущий статус вывода.
sub ErrorReporting(;$)
{	my ($lev)=@_;
	my $old = $ErrorReporting;
	$ErrorReporting = $lev if defined $lev;
	return $old;
}


# Добавляет сообщение об ошибке к массиву ошибок.
sub Warning($)
{	my ($msg)=@_;
	push(@Errors, $msg);
}


# Печатает все накопившиеся сообщения об ошибках.
# Эта функция вызывается в момент, когда STDOUT находится в "подвешенном" состоянии, 
# поэтому использование print ЗАПРЕЩЕНО!!!
sub __PrintAllErrors()
{	local $^W = undef;
	# http://forum.dklab.ru/perl/symbiosis/Fastcgi+WeboutUtechkaPamyati.html
	if(!@Errors || !$ErrorReporting){
		@Errors=(); 
        	return ; 
	}
	if (IsWebMode) {
		if ($ErrorReporting == ER_Err2Browser) {
			# мало ли, какие там были таблицы...
			echo "</script>","</table>"x6,"</pre>"x3,"</tt>"x2,"</i>"x2,"</b>"x2;
		}
		my %wasErr=();
		for (my $i=0; $i<@Errors; $i++) {
			chomp(my $st = $Errors[$i]); 
			# Исключаем дублирующиеся сообщения о ФАТАЛЬНЫХ ошибках.
			next if $wasErr{$st};
			$wasErr{$st}=1 if $st =~ /^Fatal:/;
			# Выводим сообщение.
			if ($ErrorReporting == ER_Err2Browser) {
				$st=~s/>/&gt;/sg;
				$st=~s/</&lt;/sg;
				$st=~s|^([a-zA-Z]+:)|<b>$1</b>|mgx;
				$st=~s|\n|<br>\n&nbsp;&nbsp;&nbsp;&nbsp;|g; 
				my $s=$i+1;
				for(my $i=length($s); $i<length(scalar(@Errors)); $i++) { $s="&nbsp;$s" }
        		echo "<b><tt>$s)</tt></b> $st<br>\n"; 
			} elsif ($ErrorReporting == ER_Err2Comment) {
        		echo "\n<!-- $st -->"; 
			} elsif ($ErrorReporting == ER_Err2Plain) {
        		echo "\n$st"; 
			}
		}
	} else {
		foreach my $st (@Errors) { chomp($st); echo "\n$st" }
	}
	@Errors=();
}

return 1;
__END__

=head1 NAME

CGI::WebOut - Perl extension to handle CGI output (in PHP-style).

=head1 SYNOPSIS

  # Simple CGI script (no 500 Apache error!)
  use CGI::WebOut;
  print "Hello world!"; # wow, we may NOT output Content-type!
  # Handle output for {}-block
  my $str=grab {
    print "Hi there!\n";
  };
  $str=~s/\n/<br>/sg;
  print $str;

=head1 DESCRIPTION

This module is used to make CGI programmer's work more comfortable. 
The main idea is to handle output stream (C<STDOUT>) to avoid any data 
to be sent to browser without C<Content-type> header. Of cource,
you may also send your own headers to browser using C<Header()>. Any 
errors or warnings in your script will be printed at the bottom of the page 
"in PHP-style". You may also use C<Carp> module together with C<CGI::WebOut>.

You may also handle any program block's output (using C<print> etc.)
and place it to the variable using C<grab {...}> subroutine. It is a 
very useful feature for lots of CGI-programmers.

The last thing - support of C<try-catch> "instruction". B<WARNING:> they 
are I<not> real instructions, like C<map {...}>, C<grep {...}> etc.! Be careful
with C<return> instruction in C<try-catch> blocks.

Note: you may use C<CGI::WebOut> outside the field of CGI scripting. In "non-CGI" 
script headers are NOT output, and warnings are shown as plain-text. 
C<grab {...}>, C<try-catch> etc. work as usual.

=head2 New features in version 2.0

Since version 2.0 module if fully tie-safe. That means the code:

  tie(*STDOUT, "T");
  eval "use CGI::WebOut";
  print "OK!";
  untie(*STDOUT);

generates I<exactly> the same sequense of T method calls as:

  tie(*STDOUT, "T");
  print "OK!";
  untie(*STDOUT);

So you can use CGI::WebOut with, for example, FastCGI module.

=head2 EXPORT

All the useful functions. Larry says it is not a good idea, 
but Rasmus does not think so.

=head1 EXAMPLES

  # Using Header()
  use CGI::WebOut;
  NoAutoflush();
  print "Hello world!"
  Header("X-Powered-by: dklab");

  # Handle output buffer
  use CGI::WebOut;
  my $str=grab {
    print "Hi there!\n";
	# Nested grab!
	my $s=grab {
		print "This string will be redirect to variable!";
	}
  }
  $str=~s/\n/<br>/sg;

  # Exception/warnings handle
  use CGI::WebOut;
  try {
    DoSomeDangerousStuff();
  } catch {
    print "An error occured: $_";
	throw "Error";
  } warnings {
    print "Wanning & error messages:".join("\n",@_);
  };



=head1 DESCRIPTION

=over 13

=item C<use CGI::WebOut [($forgotAboutHeaders)]>

Handles the C<STDOUT> to avoid document output without C<Content-type> header in "PHP-style". If C<$forgotAboutHeaders> is true, following "print" will produse output of all HTTP headers. Use this options only in FastCGI environment.


=item C<string grab { ... }>

Handles output stream. Usage:

    $grabbed = grab { 
        print 'Hello!' 
    } catch { 
        die "An error occurred while grabbing the output: $@"; 
    };

or simply

    $grabbed = grab { print 'Hello!' };


=item C<bool try {...} catch {...} warnings {...}>

Try-catch preudo-instruction. Usage:

    try { 
       some dangeorus code, which may call die() or
       any other bad function (or throw "instruction")
    } catch {
       use $_ to get the exception or error message
    } warnings {
       use @_ to get all the warning messages
    }

Note: C<catch> and C<warnings> blocks are optional and called in 
order of their appearance.


=item C<void throw($exception_object)>

Throws an exception.

=item C<int ErrorReporting([int $level])>

Sets the error handling mode. C<$level> may be:

    ER_NoErr       - no error reporting;
    ER_Err2Browser - errors are printed to browser;
    ER_Err2Comment - errors are printed to browser inside <!-- ... -->;
    ER_Err2Plain   - plain-text warnings.

Returns the previous error reporting mode.


=item C<void Header(string $header)>

Sets document responce header. If autoflush mode is not set, this 
function may be used just I<before> the first output.


=item C<int SetAutoflush([bool $mode])>

Sets the autoflush mode (C<$mode>!=0) or disables if (C<$mode>=0). Returns the
previous status of autoflush mode.


=item C<int NoAutoflush()>

Equivalents to C<SetAutoflush(0)>.


=item C<int UseAutoflush()>

Equivalents to C<SetAutoflush(1)>.


=item C<void Flush()>

Flushes the main output buffer to browser. If autoflush mode is set,
this function is called automatically after each C<print> call.


=item C<void Redirect(string $URL)>

Sends C<Location: $URL> header to redirect the browser to C<$URL>. Also finishes the script with C<exit()> call.


=item C<void ExternRedirect(string $URL)>

The same as C<Redirect()>, but first translates C<$URL> to absolute format: "http://host/url".


=item C<void NoCache()>

Disables browser document caching.

=back

=head1 AUTHOR

Dmitry Koteroff <koteroff@cpan.org>, http://dklab.ru/chicken/4.html

=head1 SEE ALSO

C<CGI::WebIn>, C<Carp>.

=cut
