Subversion Repositories HomeAutomation

Rev

Rev 2158 | Blame | Compare with Previous | Last modification | View Log | SVN | RSS feed

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