#ver 0.03 (C)Cyr
use strict;
use warnings;
use diagnostics;
use IO::Socket;
use Convert::ASN1;
#use Data::Dumper;
use Carp;
use POSIX;
my $CSTAapdu;
my $socket;

sub decode_msg_header {
	my $bin = shift;
	my $len = unpack('n', $bin);
	return $len;
}
sub encode_msg_header {
	my $len = shift;
	die "Message larger than allowed!" unless ($len <= 240);
	my $bin = pack('n', $len);
	return $bin;
}
sub convert_to_hex {
	my $pdu = $_[0];
	my $hexdata = unpack('H*', $pdu);
	$hexdata =~ tr/a-z/A-Z/;
	$hexdata =~ s/(..)/$1 /g;
	$hexdata =~ s/ $//g;
	return $hexdata;
}
sub send_pdu {
	my $pdu = $_[0];
	my $header = encode_msg_header(length($pdu));
	$socket->write($header); 
	$socket->write($pdu);
#	my $hexdata = convert_to_hex($pdu);
#	print("SENT:    [$hexdata]\n"); 
} 
sub csta_connect {
	my %args = %{$_[0]}; 
	open_csta_socket($args{host}, $args{port});
	# A-ASSOCIATE Request
	my $pdu = "602380020780A10706052B0C00815ABE14281206072B0C00821D8148A007A0050303000800";
    $pdu = pack('H*', $pdu);
	send_pdu($pdu);
	# A-ASSOCIATE Result 
	$pdu = receive_stuff();
	my $hexdata = convert_to_hex($pdu);
	if ($hexdata =~/A2 03 02 01 01/){
		print "rejected-permanent\n";
		exit 0
	}
	#SystemStatus Request
	$pdu = receive_stuff();
	my $out = $CSTAapdu->decode($pdu);
	my $invokeID  = $out->{svcRequest}->{invokeID};
	SystemStatusResult($invokeID);
}
	
sub open_csta_socket {
	my $host = shift;
	my $port = shift;
	$socket = new IO::Socket::INET(
        PeerAddr => $host,
        PeerPort => $port,
		Blocking => 1,
		Proto => 'tcp') || die "Error creating socket: $!\n";
	$socket->autoflush(1);
	print("opened a connection to $host on port $port\n");
}	
sub receive_stuff {
	my $header = '';
	my $pdu = '';
	my $nbytes = $socket->sysread($header, 2);
	if ($nbytes==1) { # фрагмент пакета
		my $header2;
		my $nbytes2= $socket->sysread($header2, 1);
		$header = $header.$header2;
		$nbytes = 2;
	} 
	croak "Didn't receive the specified amount of data (2 bytes)!\n".chr(7) unless ($nbytes == 2);
	my $len = decode_msg_header($header);
	$nbytes = $socket->sysread($pdu, $len);
	if ($nbytes<$len) { # фрагмент пакета
		my $pdu2;
		my $nbytes2= $socket->sysread($pdu2, $len-$nbytes);
		$pdu = $pdu.$pdu2;
		$nbytes = $nbytes + $nbytes2;
	} 
	croak "Didn't receive the specified amount of data ($len bytes)!\n".chr(7) unless ($nbytes == $len);
#	my $hexdata = convert_to_hex($pdu);
#	print("RECEIVED:[$hexdata]\n");
	return $pdu;
}
sub SystemStatusResult{
	my $invokeID = shift;
	my $pdu = $CSTAapdu->encode({svcResult=>{invokeID=>$invokeID,result=>{serviceID=>211,serviceResult=>{noData=>1}}}});
	send_pdu($pdu); # send SystemStatus Result
}
sub makeCall{
	my $dialingNumber = shift;
	my $pdu = $CSTAapdu->encode({svcRequest=>{
									invokeID=>9,
									serviceID=>10,
									serviceArgs=>{
										callingDevice=>{
											deviceIdentifier=>{
												dialingNumber=>$dialingNumber # номер абонента 
															  }
														},
										calledDirectoryNumber=>{
											deviceIdentifier=>{
												dialingNumber=>178 # номер ICD автоинформатора
															  }
															}
												 }
											}	
                            });
	send_pdu($pdu);	
	$pdu = receive_stuff();	
	#Convert::ASN1::asn_dump($pdu);
	my $out = $CSTAapdu->decode($pdu);
	#$Data::Dumper::Indent=1;
	#$Data::Dumper::Pair=' ';
	#$Data::Dumper::Quotekeys=0;
	#$Data::Dumper::Varname='CSTAapdu';
	#print Dumper($out);
	if (defined $out->{svcResult}->{result}->{serviceResult}->{callingDevice}) {
		print $out->{svcResult}->{result}->{serviceResult}->{callingDevice}->{both}->{deviceID}->{staticID}->{deviceIdentifier}->{dialingNumber},"\n"
	} elsif (defined $out->{svcError}->{parameter}) {
		#my $error_parameter = (keys %{$out->{svcError}->{parameter}})[0];
		#print $error_parameter,"\n";
		if (defined $out->{svcError}->{parameter}->{operation}) {
			my $OperationErrors = $out->{svcError}->{parameter}->{operation};
			if  ($OperationErrors ==12) { 
				print $dialingNumber," - invalidDeviceID\n"
			} elsif ($OperationErrors ==6) {
				print $dialingNumber," - invalidCalledDeviceID\n"
			} elsif ($OperationErrors ==31) {
				print $dialingNumber," - invalidParameterValue\n"
			} elsif ($OperationErrors ==2) {
				print $dialingNumber," - requestIncompatibleWithObject\n"
			} else {
				print "OperationErrors:",$OperationErrors,"\n"
			}
		} elsif (defined $out->{svcError}->{parameter}->{stateIncompatibility}) {
			my $StateIncompatibilityErrors = $out->{svcError}->{parameter}->{stateIncompatibility};
			if  ($StateIncompatibilityErrors == 2) {
				print $dialingNumber," - invalidObjectState\n"
			} else {
			print "StateIncompatibilityErrors:",$StateIncompatibilityErrors;
			}
		} elsif (defined $out->{svcError}->{parameter}->{systemResourceAvailability}) {
			my $SystemResourceAvailabilityErrors = $out->{svcError}->{parameter}->{systemResourceAvailability};
			if  ($SystemResourceAvailabilityErrors == 15) {
				print $dialingNumber," - deviceOutOfService\n"
			} else {
			print "SystemResourceAvailabilityErrors:",$SystemResourceAvailabilityErrors;
			}
		} else {
			print Dumper($out)
		}
	} else {
	print Dumper($out)
	}
}				
# parse ASN.1 desciptions
my $asn = Convert::ASN1->new;
#$asn->configure(tagdefault=>'EXPLICIT');
$asn->prepare(<<ASN1) or die "prepare: ", $asn->error;
CSTAapdu ::= CHOICE {
    svcRequest      ROIVapdu,
    svcResult       RORSapdu,
	svcError        ROERapdu
--  svcReject       RORJapdu
}
ROIVapdu ::= [1] IMPLICIT SEQUENCE {
	invokeID	  INTEGER,  
	serviceID	  INTEGER, 
	serviceArgs	  ANY DEFINED BY serviceID 
}
RORSapdu ::= [2] IMPLICIT SEQUENCE {
	invokeID	  INTEGER,     
	result            SEQUENCE {
		serviceID	  INTEGER,
		serviceResult ANY DEFINED BY serviceID OPTIONAL
	}
}
ROERapdu ::= [3] IMPLICIT SEQUENCE {
	invokeID	 INTEGER,      
	code		 INTEGER, -- local:1   
	parameter 	 UniversalFailure
}
UniversalFailure ::= CHOICE
{	operation			 	 	[0] EXPLICIT OperationErrors,
	stateIncompatibility       	[2] EXPLICIT StateIncompatibilityErrors,
	systemResourceAvailability 	[3] EXPLICIT SystemResourceAvailabilityErrors,
	unspecified                	[7] UnspecifiedErrors
}
OperationErrors ::= ENUMERATED
{	
	invalidDeviceID				(12),
	invalidCalledDeviceID		(6),
	invalidParameterValue		(31),
	requestIncompatibleWithObject (2)
}
StateIncompatibilityErrors ::= ENUMERATED
{
	invalidObjectState				(2)
}
SystemResourceAvailabilityErrors ::= ENUMERATED
{
	deviceOutOfService				(15)
}
UnspecifiedErrors ::= NULL
	
--makeCall		OPERATION ::=
--{	ARGUMENT	MakeCallArgument
--	RESULT	MakeCallResult
--	ERRORS	{universalFailure}
--	CODE	local: 10
--}

MakeCallArgument ::= SEQUENCE
{	callingDevice			DeviceID,
	calledDirectoryNumber	DeviceID
}
MakeCallResult ::= SEQUENCE
{	callingDevice		 ConnectionID}

ConnectionID ::= [APPLICATION 11] CHOICE
{
	deviceID	[1]	LocalDeviceID,
	both	SEQUENCE
	{	callID 	 [0] IMPLICIT CallID,
		deviceID [1] LocalDeviceID
	}
}

CallID ::= OCTET STRING 

LocalDeviceID ::= CHOICE
{   staticID        DeviceID}

DeviceID ::= SEQUENCE 
{	deviceIdentifier		CHOICE
	{	dialingNumber		[0] IMPLICIT	NumberDigits,
		deviceNumber		[1] IMPLICIT	DeviceNumber,
		other				[6] IMPLICIT	OtherPlan
	}
}
OtherPlan ::= OCTET STRING
 	
NumberDigits ::= IA5String

DeviceNumber ::= INTEGER

systemStatus ::= CHOICE
{	ARGUMENT SystemStatusArg,
	RESULT 	 SystemStatusRes
--	ERRORS 	{universalFailure}
--	CODE	local: 211	
}
SystemStatusArg ::= SEQUENCE
{	systemStatus	SystemStatus}

SystemStatusRes ::= CHOICE 
{	noData	 NULL}

SystemStatus ::= ENUMERATED
{   normal               (2),
    messageLost          (3),
    overloadReached      (6)
}
ASN1
my %serviceArgs = ( #51=> 'EscapeArgument',
					10 => 'MakeCallArgument',
					211=> 'SystemStatusArg');
foreach (keys %serviceArgs) {
	$asn->registertype('serviceArgs',$_,$asn->find($serviceArgs{$_}));
}
my %serviceResults = (  #51=> 'EscapeResult',
						10 => 'MakeCallResult',
						211=> 'SystemStatusRes');
foreach (keys %serviceResults) {
	$asn->registertype('serviceResult',$_,$asn->find($serviceResults{$_}));
} 
$CSTAapdu = $asn->find('CSTAapdu');
csta_connect({'host'=>'192.168.0.66', 'port'=>33333});
print "makeCall:\n";
my @devices = (106, 111, 155, 156); # список номеров
my $i=0;
for (@devices) {
	makeCall($_);
	if ($i++%2) { # 2 - количество каналов SVM
	sleep 3 # задержка на сообщение
	}
}