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