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

Subversion Repositories HomeAutomation

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