package Tie;

use strict;
use vars qw(@ISA @EXPORT $dbSQL $STYLE);
use IO::Socket;
use UAcoder;
use DBI;
use CGI::Carp qw(fatalsToBrowser);

use Exporter;
@ISA= qw(Exporter);
@EXPORT= qw(&Tie &Coding &Decoding $Q $A $dbSQL $STYLE);

########################################### Пути

my $HOST= 'www.myhost.ru';			#удалённый хост
my $PATH= '/cgi-bin/ua/tables.cgi';	#путь к файлу tables.cgi

########################################### Подключение к MySQL

$dbSQL= DBI->connect(
	DBI:mysql:db_name:localhost,user,password, #данные для подключения к MySQL
	{RaiseError=>1} );

########################################### Пароль

open OP, "./password/password" or die'no file /password/password!\n';
my $tieKEY= <OP>; close OP;

########################################### Стили

$STYLE= "UL {text-align:left;list-style-position:inside;margin:1}
LI {margin:1;background-color:#EEE;padding:2}
LI,TD,BODY {font-size:14;font-family:Courier New;}";

###########################################

sub Tie{
	my $ctx= new UAcoder();
	$ctx->pass($tieKEY);

	$Q->param(-name=>'HOST', -values=>$HOST);

	my $L= $ctx->coding;
	my $length= length($L);

	my $req= "POST $PATH HTTP/1.0\n".
	"Content-type: application/x-www-form-urlencoded\n".
	"Content-length: $length\nHost: $HOST\n\n$L\n";

	my $socket=IO::Socket::INET->new(PeerAddr=>$HOST, Proto=>'tcp', PeerPort=>80) or die "No connect from $HOST!\n";
	print $socket $req;

	my $LRec='';
	while( <$socket> ){ chomp; $LRec=$_ unless /[^A-F0-9]/i }
	die "Нет ответа в виде ЗСТР от сервера $HOST!\n" if length $LRec<30;

	$ctx->line($LRec);
	$ctx->decoding;

	my $hostRet= defined $A->param('HOST') ? $A->param('HOST') : '';
	if( $hostRet eq $HOST ){ $A->delete('HOST') }
	else{ $A->delete_all(); die "HOST(ы) передачи и приёма не соответствуют: $HOST\n" }

	my $errRet= defined $A->param('ERROR') ? $A->param('ERROR') : '';
	if( $errRet ){ $A->delete_all(); die "С $HOST вернулась ошибка: $errRet\n" }
}


sub Coding{
	my $ctx= new UAcoder();
	$ctx->pass($tieKEY);

	print $Q->header;
	print $ctx->coding;
}


sub Decoding{
	my $ctx= new UAcoder();
	$ctx->pass($tieKEY);

	$ctx->line();
	$ctx->decoding;

	$Q->param(-name=>'HOST', -values=>$HOST);
}


1;

END{ $A->delete_all(); $Q->delete_all() }

###########################################

=head AUTHOR

V. V. Gorhilin, arhitrade@mail.ru
http://uniq-ip.biz/gorchilin/UAcoder/uacoder.htm
2004

=cut