Subversion Repositories HomeAutomation

Rev

Rev 2101 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | SVN | RSS feed

Rev Author Line No. Line
1884 arune 1
use IO::Select;
1885 arune 2
use IO::Socket;
1884 arune 3
 
4
 
5
sub atomd_connect
6
{
7
	($host, $port) = @_;
8
	$socket = IO::Socket::INET->new(
9
			Proto    => "tcp",
10
			PeerAddr => $host,
11
			PeerPort => $port,
12
			Blocking => 1,
13
		)
14
		or die "Error: Cannot connect to port $port at $host\n";
15
 
16
	return $socket;
17
}
18
 
2158 arune 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 -----------------
51
 
1884 arune 52
sub atomd_read_packet
53
{
54
	($socket) = @_;
55
	$command="";
56
	read($socket, $command, 4);
57
 
58
	$payload_length="";
59
	read($socket, $payload_length, 4);
60
 
61
	$payload_length = int($payload_length);
62
	$payload="";
63
	if ($payload_length > 0)
64
	{
2002 arune 65
		read($socket, $payload, $payload_length-1);
1884 arune 66
	}
2002 arune 67
 
1884 arune 68
	#Pad payload length with 0s
2002 arune 69
	$payload_length = sprintf("%04d", $payload_length-1);
1884 arune 70
 
71
	#print "areadpacket ".$command . $payload_length . $payload."\n";
72
	return $command . $payload_length . $payload;
73
}
74
 
75
sub atomd_write_packet
76
{
77
	($socket, $command, $payload) = @_;
78
 
79
	#Pad payload length with 0s
2002 arune 80
#	$payload_length = sprintf("%04d", length($payload)+1);
81
#	$packet = $command.$payload_length.$payload.chr(0);
82
	$payload_length = sprintf("%04d", length($payload));
83
	$packet = $command.$payload_length.$payload;
1884 arune 84
 
85
	#print "awritepacket ".$packet."\n";
86
	print $socket $packet;
87
}
88
 
89
 
90
sub atomd_data_available
91
{
92
	($socket) = @_;
93
 
94
	$s = IO::Select->new();
95
	$s->add($socket);
2101 arune 96
	@handles = $s->can_read(0.005);
1884 arune 97
 
98
	$has_data = 0;
99
	if (@handles)
100
	{
101
		$has_data = 1;
102
	}
103
 
104
	return $has_data;
105
}
106
 
1890 arune 107
sub atomd_kill_promt
108
{
109
	($socket) = @_;
1884 arune 110
 
1890 arune 111
	while (atomd_data_available($socket))
112
	{
113
		$packet = atomd_read_packet($socket); # Read prompt
114
	}
115
}
116
 
1884 arune 117
sub atomd_initialize
118
{
119
	($host, $port) = @_;
120
	$socket = atomd_connect($host, $port);
121
 
1890 arune 122
	atomd_kill_promt($socket);
1884 arune 123
 
124
	return $socket;
125
}
126
 
127
 
128
sub atomd_send_command
129
{
130
	($socket, $command) = @_;
131
	atomd_write_packet($socket, "RESP", $command);
132
}
133
 
134
 
135
sub atomd_read_command_response
136
{
137
	($socket) = @_;
138
 
139
	$response = "";
140
 
141
	while (1)
142
	{
143
		$packet = atomd_read_packet($socket);
144
		if (substr($packet, 0, 4) ne "TEXT")
145
		{
146
			last;
147
		}
148
 
149
		$packet =~ s/\n//g;
2002 arune 150
#		$response .= substr($packet, 8, -1); 
151
		$response .= substr($packet, 8); 
1884 arune 152
		$response .= "\n";
153
	}
154
 
155
	return $response;
156
}
157
 
2002 arune 158
 
159
# Perl trim function to remove whitespace from the start and end of the string
160
sub trim($)
161
{
162
	my $string = shift;
163
	$string =~ s/^\s+//;
164
	$string =~ s/\s+$//;
165
	return $string;
166
}
167
# Left trim function to remove leading whitespace
168
sub ltrim($)
169
{
170
	my $string = shift;
171
	$string =~ s/^\s+//;
172
	return $string;
173
}
174
# Right trim function to remove trailing whitespace
175
sub rtrim($)
176
{
177
	my $string = shift;
178
	$string =~ s/\s+$//;
179
	return $string;
180
}
181
 
182
 
183
 
1884 arune 184
# "return" 1 to not generate an error when loading file
185
1;
186