#!/usr/bin/perl -w

use strict;
use XML::DOM;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);

print "Content-type: text/html; charset=windows-1251\n\n";

#----------------------------------------
## Parse incoming data
##
my $buffer;
my $ua= LWP::UserAgent->new;
$ua->agent("Alarm");
my %params;
my %paramhash1;
my %paramhash2;

$paramhash1{"ANASAT"}="TXFREQ";
$paramhash2{"ANASAT"}="RXFREQ";
$paramhash1{"DMD2400"}="MCF";
$paramhash2{"DMD2400"}="DCF";
$paramhash1{"DMD2401"}="ModFrequency";
$paramhash2{"DMD2401"}="DemFrequency";
$paramhash1{"P300"}="TxIFFreq";
$paramhash2{"P300"}="RxIFFreq";
$paramhash1{"P3000"}="TIFTxIFFreq";
$paramhash2{"P3000"}="RIFRxIFFreq";
$paramhash1{"PS30Y"}="UIn";
$paramhash2{"PS30Y"}="CBatt";
$paramhash1{"PSM4900"}="ModIF__CxrFreq";
$paramhash2{"PSM4900"}="DemIF__CxrFreq";
$paramhash1{"RADIS"}="OPP";
$paramhash2{"RADIS"}="IPP";
$paramhash1{"PRESTIGE"}="LOAD_VOLT";
$paramhash2{"PRESTIGE"}="FREQUENCY";
$paramhash1{"PS30Y"}="UOut";
$paramhash2{"PS30Y"}="CBatt";
$paramhash1{"PW9170"}="POWERW";
$paramhash2{"PW9170"}="FREQUENCYO";
$paramhash1{"CDM550"}="TFQ";
$paramhash2{"CDM550"}="RFQ";
$paramhash1{"CDM550L"}="TFQ";
$paramhash2{"CDM550L"}="RFQ";
$paramhash1{"CDM570"}="TFQ";
$paramhash2{"CDM570"}="RFQ";
$paramhash1{"CDM570L"}="TFQ";
$paramhash2{"CDM570L"}="RFQ";
$paramhash1{"CDM600"}="TFQ";
$paramhash2{"CDM600"}="RFQ";
$paramhash1{"CDM600L"}="TFQ";
$paramhash2{"CDM600L"}="RFQ";
$paramhash1{"CODAN"}="OTD";
$paramhash2{"CODAN"}="OCN";
$paramhash1{"BDMT2"}="T";
$paramhash2{"BDMT2"}="T";
$paramhash1{"PARADISEPA"}="Temperature";
$paramhash2{"PARADISEPA"}="Power";
$paramhash1{"PW9125"}="UIn";
$paramhash2{"PW9125"}="CBatt";
$paramhash1{"LOOPBACK"}="S";
$paramhash2{"LOOPBACK"}="S";
$paramhash1{"SDM2020M"}="MF";
$paramhash2{"SDM2020M"}="RF";
$paramhash1{"SDM2020D"}="DF";
$paramhash2{"SDM2020D"}="EBN0";
$paramhash1{"SDM300A"}="MF";
$paramhash2{"SDM300A"}="DF";
$paramhash1{"UMR"}="OPP1";
$paramhash2{"UMR"}="OPP2";
$paramhash1{"WGSR"}="POS";
$paramhash2{"WGSR"}="Conn";
$paramhash1{"IFCR"}="Pwr";
$paramhash2{"IFCR"}="RChan";
$paramhash1{"LNAR"}="Cur";
$paramhash2{"LNAR"}="Pwr";
$paramhash1{"LNARR"}="Cur";
$paramhash2{"LNARR"}="Pwr";

if ($ENV{REQUEST_METHOD} eq 'POST') {
    read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
    $buffer .= "&";
    $buffer .= $ENV{QUERY_STRING};
} 
else {
    $buffer = $ENV{QUERY_STRING};
}
my @pairs = split(/&/, $buffer);
my $pair;

foreach $pair(@pairs) {
    (my $key, my $value) = split(/=/, $pair);
    $value =~ tr/+/ /;
    $value =~ s/%0D%0A/"%0A"/eg;
    $value =~ s/%([A-Fa-f0-9]{2})/pack("C",hex($1))/eg;
    if (defined $params{$key}) {
	$params{$key} .= "\t$value";
    } 
    else {
	$params{$key} = $value;
    }
}

my $xmlresult;
$xmlresult = "
<data>
<task>
<get>
<param name=\"" . $paramhash1{$params{"Device"}} . "\"/>
<param name=\"" . $paramhash2{$params{"Device"}} . "\"/>
</get>
<device type=\"" . $params{"Device"} . "\">
<parameter name=\"Address\">" . $params{"Address"} ."</parameter> 
<parameter name=\"Attempts\">" . $params{"Attempts"} ."</parameter> 
<parameter name=\"Timeout\">" . $params{"Timeout"} ."</parameter> 
</device>
<port type=\"COMPort\">
<parameter name=\"Number\">" . $params{"Number"} ."</parameter> 
<parameter name=\"Speed\">" . $params{"Speed"} ."</parameter> 
<parameter name=\"Parity\">" . $params{"Parity"} ."</parameter> 
<parameter name=\"Bits\">" . $params{"Bits"} ."</parameter> 
<parameter name=\"StopBit\">" . $params{"StopBit"} ."</parameter> 
</port>
</task>
</data>";

print STDOUT<<EOF
<html>
<body>
EOF
;
#print $xmlresult;

$xmlresult =~  s/([^\w()'*~!.-])/sprintf '%%%02x', ord $1/eg;
#'

my $req = HTTP::Request->new(POST => 'http://127.0.0.1/cgi-bin/connection.pl');
$req->content_type('application/x-www-form-urlencoded');
$req->content("xml=$xmlresult"); 
my $res = $ua->request($req);

if($res->is_success)  {
}

else {
    print "<h2> <font color=\"red\"> Failed to execute connection! </font> </h3> <br />\n";
}

my $device = $params{"Device"};
my $portnum = $params{"Number"};

print STDOUT<<EOF
<html>
<title>Satis Controller Tester</title>
<body>
Устройство ${device} на порту #${portnum} было опрошено с результатом: 
<br />
<br />
EOF
;

my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($res->content);
my $status = -1;
my $paramlist = $doc->getElementsByTagName("param");
my $k;
for($k = 0; $k < $paramlist->getLength; $k++) {
    my $name=$paramlist->item($k)->getAttribute("name");
    $status=$paramlist->item($k)->getAttribute("status");
    my $value = "";
    if(defined($paramlist->item($k)->getChildNodes->item(0))) {
	$value=$paramlist->item($k)->getChildNodes->item(0)->getData;
    }

#    my $value=$paramlist->item($k)->getChildNodes->item(0)->nodeValue;
    if($status == 0) {
	print $name . "=" . $value;
        print "<br />"
    }
}

#print "End of printing.\n";
if($status == 0) {
    print "<h3><font color=\"lime\">Устройство подключено правильно.</font></h3><br />";
}

else {
    print "<h3><font color=\"red\">Устройство подключено неправильно или не отвечает.</h3> </font><br />";
}

print STDOUT<<EOF
<a href="../HTMLTester/index.html"> Новый опрос </a>
</body>
</html>
EOF
;

$doc->dispose;