Subversion Repositories HomeAutomation

Rev

Rev 2101 | Go to most recent revision | 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. # ----------------- 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.  
  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.     {
  65.         read($socket, $payload, $payload_length-1);
  66.     }
  67.  
  68.     #Pad payload length with 0s
  69.     $payload_length = sprintf("%04d", $payload_length-1);
  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
  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;
  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);
  96.     @handles = $s->can_read(0.005);
  97.  
  98.     $has_data = 0;
  99.     if (@handles)
  100.     {
  101.         $has_data = 1;
  102.     }
  103.    
  104.     return $has_data;
  105. }
  106.  
  107. sub atomd_kill_promt
  108. {
  109.     ($socket) = @_;
  110.  
  111.     while (atomd_data_available($socket))
  112.     {
  113.         $packet = atomd_read_packet($socket); # Read prompt
  114.     }
  115. }
  116.  
  117. sub atomd_initialize
  118. {
  119.     ($host, $port) = @_;
  120.     $socket = atomd_connect($host, $port);
  121.    
  122.     atomd_kill_promt($socket);
  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;
  150. #       $response .= substr($packet, 8, -1);
  151.         $response .= substr($packet, 8);
  152.         $response .= "\n";
  153.     }
  154.  
  155.     return $response;
  156. }
  157.  
  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.  
  184. # "return" 1 to not generate an error when loading file
  185. 1;
  186.  
  187.