Rev 1884 | Rev 1890 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | SVN | RSS feed
| Rev 1884 | Rev 1885 | ||
|---|---|---|---|
| 1 | use IO::Select; |
1 | use IO::Select; |
| - | 2 | use IO::Socket; |
|
| 2 | 3 | ||
| 3 | 4 | ||
| 4 | sub atomd_connect |
5 | sub atomd_connect |
| 5 | { |
6 | { |
| 6 | ($host, $port) = @_; |
7 | ($host, $port) = @_; |
| 7 | $socket = IO::Socket::INET->new( |
8 | $socket = IO::Socket::INET->new( |
| 8 | Proto => "tcp", |
9 | Proto => "tcp", |
| 9 | PeerAddr => $host, |
10 | PeerAddr => $host, |
| 10 | PeerPort => $port, |
11 | PeerPort => $port, |
| 11 | Blocking => 1, |
12 | Blocking => 1, |
| 12 | ) |
13 | ) |
| 13 | or die "Error: Cannot connect to port $port at $host\n"; |
14 | or die "Error: Cannot connect to port $port at $host\n"; |
| 14 | 15 | ||
| 15 | return $socket; |
16 | return $socket; |
| 16 | } |
17 | } |
| 17 | 18 | ||
| 18 | sub atomd_read_packet |
19 | sub atomd_read_packet |
| 19 | { |
20 | { |
| 20 | ($socket) = @_; |
21 | ($socket) = @_; |
| 21 | $command=""; |
22 | $command=""; |
| 22 | read($socket, $command, 4); |
23 | read($socket, $command, 4); |
| 23 | 24 | ||
| 24 | $payload_length=""; |
25 | $payload_length=""; |
| 25 | read($socket, $payload_length, 4); |
26 | read($socket, $payload_length, 4); |
| 26 | 27 | ||
| 27 | $payload_length = int($payload_length); |
28 | $payload_length = int($payload_length); |
| 28 | $payload=""; |
29 | $payload=""; |
| 29 | if ($payload_length > 0) |
30 | if ($payload_length > 0) |
| 30 | { |
31 | { |
| 31 | read($socket, $payload, $payload_length); |
32 | read($socket, $payload, $payload_length); |
| 32 | } |
33 | } |
| 33 | 34 | ||
| 34 | #Pad payload length with 0s |
35 | #Pad payload length with 0s |
| 35 | $payload_length = sprintf("%04d", $payload_length); |
36 | $payload_length = sprintf("%04d", $payload_length); |
| 36 | 37 | ||
| 37 | #print "areadpacket ".$command . $payload_length . $payload."\n"; |
38 | #print "areadpacket ".$command . $payload_length . $payload."\n"; |
| 38 | return $command . $payload_length . $payload; |
39 | return $command . $payload_length . $payload; |
| 39 | } |
40 | } |
| 40 | 41 | ||
| 41 | sub atomd_write_packet |
42 | sub atomd_write_packet |
| 42 | { |
43 | { |
| 43 | ($socket, $command, $payload) = @_; |
44 | ($socket, $command, $payload) = @_; |
| 44 | 45 | ||
| 45 | #Pad payload length with 0s |
46 | #Pad payload length with 0s |
| 46 | $payload_length = sprintf("%04d", length($payload)+1); |
47 | $payload_length = sprintf("%04d", length($payload)+1); |
| 47 | $packet = $command.$payload_length.$payload.chr(0); |
48 | $packet = $command.$payload_length.$payload.chr(0); |
| 48 | 49 | ||
| 49 | #print "awritepacket ".$packet."\n"; |
50 | #print "awritepacket ".$packet."\n"; |
| 50 | print $socket $packet; |
51 | print $socket $packet; |
| 51 | } |
52 | } |
| 52 | 53 | ||
| 53 | 54 | ||
| 54 | sub atomd_data_available |
55 | sub atomd_data_available |
| 55 | { |
56 | { |
| 56 | ($socket) = @_; |
57 | ($socket) = @_; |
| 57 | 58 | ||
| 58 | $s = IO::Select->new(); |
59 | $s = IO::Select->new(); |
| 59 | $s->add($socket); |
60 | $s->add($socket); |
| 60 | @handles = $s->can_read(0.01); |
61 | @handles = $s->can_read(0.01); |
| 61 | 62 | ||
| 62 | $has_data = 0; |
63 | $has_data = 0; |
| 63 | if (@handles) |
64 | if (@handles) |
| 64 | { |
65 | { |
| 65 | $has_data = 1; |
66 | $has_data = 1; |
| 66 | } |
67 | } |
| 67 | 68 | ||
| 68 | return $has_data; |
69 | return $has_data; |
| 69 | } |
70 | } |
| 70 | 71 | ||
| 71 | 72 | ||
| 72 | sub atomd_initialize |
73 | sub atomd_initialize |
| 73 | { |
74 | { |
| 74 | ($host, $port) = @_; |
75 | ($host, $port) = @_; |
| 75 | $socket = atomd_connect($host, $port); |
76 | $socket = atomd_connect($host, $port); |
| 76 | 77 | ||
| 77 | while (atomd_data_available($socket)) |
78 | while (atomd_data_available($socket)) |
| 78 | { |
79 | { |
| 79 | $packet = atomd_read_packet($socket); # Read initial prompt |
80 | $packet = atomd_read_packet($socket); # Read initial prompt |
| 80 | } |
81 | } |
| 81 | 82 | ||
| 82 | return $socket; |
83 | return $socket; |
| 83 | } |
84 | } |
| 84 | 85 | ||
| 85 | 86 | ||
| 86 | sub atomd_send_command |
87 | sub atomd_send_command |
| 87 | { |
88 | { |
| 88 | ($socket, $command) = @_; |
89 | ($socket, $command) = @_; |
| 89 | atomd_write_packet($socket, "RESP", $command); |
90 | atomd_write_packet($socket, "RESP", $command); |
| 90 | } |
91 | } |
| 91 | 92 | ||
| 92 | 93 | ||
| 93 | sub atomd_read_command_response |
94 | sub atomd_read_command_response |
| 94 | { |
95 | { |
| 95 | ($socket) = @_; |
96 | ($socket) = @_; |
| 96 | 97 | ||
| 97 | $response = ""; |
98 | $response = ""; |
| 98 | 99 | ||
| 99 | while (1) |
100 | while (1) |
| 100 | { |
101 | { |
| 101 | $packet = atomd_read_packet($socket); |
102 | $packet = atomd_read_packet($socket); |
| 102 | 103 | ||
| 103 | if (substr($packet, 0, 4) ne "TEXT") |
104 | if (substr($packet, 0, 4) ne "TEXT") |
| 104 | { |
105 | { |
| 105 | last; |
106 | last; |
| 106 | } |
107 | } |
| 107 | 108 | ||
| 108 | $packet =~ s/\n//g; |
109 | $packet =~ s/\n//g; |
| 109 | $response .= substr($packet, 8); |
110 | $response .= substr($packet, 8); |
| 110 | $response .= "\n"; |
111 | $response .= "\n"; |
| 111 | } |
112 | } |
| 112 | 113 | ||
| 113 | return $response; |
114 | return $response; |
| 114 | } |
115 | } |
| 115 | 116 | ||
| 116 | # "return" 1 to not generate an error when loading file |
117 | # "return" 1 to not generate an error when loading file |
| 117 | 1; |
118 | 1; |
| 118 | 119 | ||
| 119 | 120 | ||