WebSVN – HomeAutomation – Diff – /trunk/PcSoftware/scripts/setConfig/AtomLib.pl


use IO::Select;
use IO::Socket;
 
 
sub atomd_connect
{
    ($host, $port) = @_;
    $socket = IO::Socket::INET->new(
            Proto    => "tcp",
            PeerAddr => $host,
            PeerPort => $port,
            Blocking => 1,
        )
        or die "Error: Cannot connect to port $port at $host\n";
 
    return $socket;
}
 
sub atomd_disconnect
{
    ($socket) = @_;
    close($socket);
}
 
# ----------------- Atom JS functions -----------------
sub atomjs_read_line
{
    ($socket) = @_;
    # read line
    defined( $result = <$socket> ) or die "Readline failed: $! \n";
   
    return $result;
}
 
sub atomjs_write
{
    ($socket, $command) = @_;
    print $socket $command;
}
 
#function atomjs_data_available($socket)
#{
#   $read   = array($socket);
#   $write  = NULL;
#   $except = NULL;
   
#   if (false === ($num_changed_streams = stream_select($read, $write, $except, 0)))
#   {
#       throw new Exception("could not do select on socket");
#   }
 
#   return $num_changed_streams > 0;
#}
 
 
# ----------------- Atomic functions -----------------
 
sub atomd_read_packet
{
    ($socket) = @_;
    $command="";
    read($socket, $command, 4);
 
    $payload_length="";
    read($socket, $payload_length, 4);
 
    $payload_length = int($payload_length);
    $payload="";
    if ($payload_length > 0)
    {
        read($socket, $payload, $payload_length-1);
    }
 
    #Pad payload length with 0s
    $payload_length = sprintf("%04d", $payload_length-1);
   
    #print "areadpacket ".$command . $payload_length . $payload."\n";
    return $command . $payload_length . $payload;
}
 
sub atomd_write_packet
{
    ($socket, $command, $payload) = @_;
   
    #Pad payload length with 0s
#   $payload_length = sprintf("%04d", length($payload)+1);
#   $packet = $command.$payload_length.$payload.chr(0);
    $payload_length = sprintf("%04d", length($payload));
    $packet = $command.$payload_length.$payload;
 
    #print "awritepacket ".$packet."\n";
    print $socket $packet;
}
 
 
sub atomd_data_available
{
    ($socket) = @_;
 
    $s = IO::Select->new();
    $s->add($socket);
    @handles = $s->can_read(0.005);
 
    $has_data = 0;
    if (@handles)
    {
        $has_data = 1;
    }
   
    return $has_data;
}
 
sub atomd_kill_promt
{
    ($socket) = @_;
 
    while (atomd_data_available($socket))
    {
        $packet = atomd_read_packet($socket); # Read prompt
    }
}
 
sub atomd_initialize
{
    ($host, $port) = @_;
    $socket = atomd_connect($host, $port);
   
    atomd_kill_promt($socket);
   
    return $socket;
}
 
 
sub atomd_send_command
{
    ($socket, $command) = @_;
    atomd_write_packet($socket, "RESP", $command);
}
 
 
sub atomd_read_command_response
{
    ($socket) = @_;
 
    $response = "";
 
    while (1)
    {
        $packet = atomd_read_packet($socket);
        if (substr($packet, 0, 4) ne "TEXT")
        {
            last;
        }
 
        $packet =~ s/\n//g;
#       $response .= substr($packet, 8, -1); 
        $response .= substr($packet, 8);
        $response .= "\n";
    }
 
    return $response;
}
 
 
# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}
# Left trim function to remove leading whitespace
sub ltrim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim($)
{
    my $string = shift;
    $string =~ s/\s+$//;
    return $string;
}
 
 
 
# "return" 1 to not generate an error when loading file
1;
 
 

Rev 2158	Rev 2159
1	use IO::Select;	1	use IO::Select;
2	use IO::Socket;	2	use IO::Socket;
3		3
4		4
5	sub atomd_connect	5	sub atomd_connect
6	{	6	{
7	($host, $port) = @_;	7	($host, $port) = @_;
8	$socket = IO::Socket::INET->new(	8	$socket = IO::Socket::INET->new(
9	Proto => "tcp",	9	Proto => "tcp",
10	PeerAddr => $host,	10	PeerAddr => $host,
11	PeerPort => $port,	11	PeerPort => $port,
12	Blocking => 1,	12	Blocking => 1,
13	)	13	)
14	or die "Error: Cannot connect to port $port at $host\n";	14	or die "Error: Cannot connect to port $port at $host\n";
15		15
16	return $socket;	16	return $socket;
-		17	}
-		18
-		19	sub atomd_disconnect
-		20	{
-		21	($socket) = @_;
-		22	close($socket);
17	}	23	}
18		24
19	# ----------------- Atom JS functions -----------------	25	# ----------------- Atom JS functions -----------------
20	sub atomjs_read_line	26	sub atomjs_read_line
21	{	27	{
22	($socket) = @_;	28	($socket) = @_;
23	# read line	29	# read line
24	defined( $result = <$socket> ) or die "Readline failed: $! \n";	30	defined( $result = <$socket> ) or die "Readline failed: $! \n";
25		31
26	return $result;	32	return $result;
27	}	33	}
28		34
29	sub atomjs_write	35	sub atomjs_write
30	{	36	{
31	($socket, $command) = @_;	37	($socket, $command) = @_;
32	print $socket $command;	38	print $socket $command;
33	}	39	}
34		40
35	#function atomjs_data_available($socket)	41	#function atomjs_data_available($socket)
36	#{	42	#{
37	# $read = array($socket);	43	# $read = array($socket);
38	# $write = NULL;	44	# $write = NULL;
39	# $except = NULL;	45	# $except = NULL;
40		46
41	# if (false === ($num_changed_streams = stream_select($read, $write, $except, 0)))	47	# if (false === ($num_changed_streams = stream_select($read, $write, $except, 0)))
42	# {	48	# {
43	# throw new Exception("could not do select on socket");	49	# throw new Exception("could not do select on socket");
44	# }	50	# }
45		51
46	# return $num_changed_streams > 0;	52	# return $num_changed_streams > 0;
47	#}	53	#}
48		54
49		55
50	# ----------------- Atomic functions -----------------	56	# ----------------- Atomic functions -----------------
51		57
52	sub atomd_read_packet	58	sub atomd_read_packet
53	{	59	{
54	($socket) = @_;	60	($socket) = @_;
55	$command="";	61	$command="";
56	read($socket, $command, 4);	62	read($socket, $command, 4);
57		63
58	$payload_length="";	64	$payload_length="";
59	read($socket, $payload_length, 4);	65	read($socket, $payload_length, 4);
60		66
61	$payload_length = int($payload_length);	67	$payload_length = int($payload_length);
62	$payload="";	68	$payload="";
63	if ($payload_length > 0)	69	if ($payload_length > 0)
64	{	70	{
65	read($socket, $payload, $payload_length-1);	71	read($socket, $payload, $payload_length-1);
66	}	72	}
67		73
68	#Pad payload length with 0s	74	#Pad payload length with 0s
69	$payload_length = sprintf("%04d", $payload_length-1);	75	$payload_length = sprintf("%04d", $payload_length-1);
70		76
71	#print "areadpacket ".$command . $payload_length . $payload."\n";	77	#print "areadpacket ".$command . $payload_length . $payload."\n";
72	return $command . $payload_length . $payload;	78	return $command . $payload_length . $payload;
73	}	79	}
74		80
75	sub atomd_write_packet	81	sub atomd_write_packet
76	{	82	{
77	($socket, $command, $payload) = @_;	83	($socket, $command, $payload) = @_;
78		84
79	#Pad payload length with 0s	85	#Pad payload length with 0s
80	# $payload_length = sprintf("%04d", length($payload)+1);	86	# $payload_length = sprintf("%04d", length($payload)+1);
81	# $packet = $command.$payload_length.$payload.chr(0);	87	# $packet = $command.$payload_length.$payload.chr(0);
82	$payload_length = sprintf("%04d", length($payload));	88	$payload_length = sprintf("%04d", length($payload));
83	$packet = $command.$payload_length.$payload;	89	$packet = $command.$payload_length.$payload;
84		90
85	#print "awritepacket ".$packet."\n";	91	#print "awritepacket ".$packet."\n";
86	print $socket $packet;	92	print $socket $packet;
87	}	93	}
88		94
89		95
90	sub atomd_data_available	96	sub atomd_data_available
91	{	97	{
92	($socket) = @_;	98	($socket) = @_;
93		99
94	$s = IO::Select->new();	100	$s = IO::Select->new();
95	$s->add($socket);	101	$s->add($socket);
96	@handles = $s->can_read(0.005);	102	@handles = $s->can_read(0.005);
97		103
98	$has_data = 0;	104	$has_data = 0;
99	if (@handles)	105	if (@handles)
100	{	106	{
101	$has_data = 1;	107	$has_data = 1;
102	}	108	}
103		109
104	return $has_data;	110	return $has_data;
105	}	111	}
106		112
107	sub atomd_kill_promt	113	sub atomd_kill_promt
108	{	114	{
109	($socket) = @_;	115	($socket) = @_;
110		116
111	while (atomd_data_available($socket))	117	while (atomd_data_available($socket))
112	{	118	{
113	$packet = atomd_read_packet($socket); # Read prompt	119	$packet = atomd_read_packet($socket); # Read prompt
114	}	120	}
115	}	121	}
116		122
117	sub atomd_initialize	123	sub atomd_initialize
118	{	124	{
119	($host, $port) = @_;	125	($host, $port) = @_;
120	$socket = atomd_connect($host, $port);	126	$socket = atomd_connect($host, $port);
121		127
122	atomd_kill_promt($socket);	128	atomd_kill_promt($socket);
123		129
124	return $socket;	130	return $socket;
125	}	131	}
126		132
127		133
128	sub atomd_send_command	134	sub atomd_send_command
129	{	135	{
130	($socket, $command) = @_;	136	($socket, $command) = @_;
131	atomd_write_packet($socket, "RESP", $command);	137	atomd_write_packet($socket, "RESP", $command);
132	}	138	}
133		139
134		140
135	sub atomd_read_command_response	141	sub atomd_read_command_response
136	{	142	{
137	($socket) = @_;	143	($socket) = @_;
138		144
139	$response = "";	145	$response = "";
140		146
141	while (1)	147	while (1)
142	{	148	{
143	$packet = atomd_read_packet($socket);	149	$packet = atomd_read_packet($socket);
144	if (substr($packet, 0, 4) ne "TEXT")	150	if (substr($packet, 0, 4) ne "TEXT")
145	{	151	{
146	last;	152	last;
147	}	153	}
148		154
149	$packet =~ s/\n//g;	155	$packet =~ s/\n//g;
150	# $response .= substr($packet, 8, -1);	156	# $response .= substr($packet, 8, -1);
151	$response .= substr($packet, 8);	157	$response .= substr($packet, 8);
152	$response .= "\n";	158	$response .= "\n";
153	}	159	}
154		160
155	return $response;	161	return $response;
156	}	162	}
157		163
158		164
159	# Perl trim function to remove whitespace from the start and end of the string	165	# Perl trim function to remove whitespace from the start and end of the string
160	sub trim($)	166	sub trim($)
161	{	167	{
162	my $string = shift;	168	my $string = shift;
163	$string =~ s/^\s+//;	169	$string =~ s/^\s+//;
164	$string =~ s/\s+$//;	170	$string =~ s/\s+$//;
165	return $string;	171	return $string;
166	}	172	}
167	# Left trim function to remove leading whitespace	173	# Left trim function to remove leading whitespace
168	sub ltrim($)	174	sub ltrim($)
169	{	175	{
170	my $string = shift;	176	my $string = shift;
171	$string =~ s/^\s+//;	177	$string =~ s/^\s+//;
172	return $string;	178	return $string;
173	}	179	}
174	# Right trim function to remove trailing whitespace	180	# Right trim function to remove trailing whitespace
175	sub rtrim($)	181	sub rtrim($)
176	{	182	{
177	my $string = shift;	183	my $string = shift;
178	$string =~ s/\s+$//;	184	$string =~ s/\s+$//;
179	return $string;	185	return $string;
180	}	186	}
181		187
182		188
183		189
184	# "return" 1 to not generate an error when loading file	190	# "return" 1 to not generate an error when loading file
185	1;	191	1;
186		192
187		193

Subversion Repositories HomeAutomation

(root)/trunk/PcSoftware/scripts/setConfig/AtomLib.pl – Rev 2158 → 2159