Subversion Repositories HomeAutomation

Rev

Rev 1892 | Rev 2158 | 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. sub atomd_read_packet
  20. {
  21.     ($socket) = @_;
  22.     $command="";
  23.     read($socket, $command, 4);
  24.  
  25.     $payload_length="";
  26.     read($socket, $payload_length, 4);
  27.  
  28.     $payload_length = int($payload_length);
  29.     $payload="";
  30.     if ($payload_length > 0)
  31.     {
  32.         read($socket, $payload, $payload_length-1);
  33.     }
  34.  
  35.     #Pad payload length with 0s
  36.     $payload_length = sprintf("%04d", $payload_length-1);
  37.    
  38.     #print "areadpacket ".$command . $payload_length . $payload."\n";
  39.     return $command . $payload_length . $payload;
  40. }
  41.  
  42. sub atomd_write_packet
  43. {
  44.     ($socket, $command, $payload) = @_;
  45.    
  46.     #Pad payload length with 0s
  47. #   $payload_length = sprintf("%04d", length($payload)+1);
  48. #   $packet = $command.$payload_length.$payload.chr(0);
  49.     $payload_length = sprintf("%04d", length($payload));
  50.     $packet = $command.$payload_length.$payload;
  51.  
  52.     #print "awritepacket ".$packet."\n";
  53.     print $socket $packet;
  54. }
  55.  
  56.  
  57. sub atomd_data_available
  58. {
  59.     ($socket) = @_;
  60.  
  61.     $s = IO::Select->new();
  62.     $s->add($socket);
  63.     @handles = $s->can_read(0.001);
  64.  
  65.     $has_data = 0;
  66.     if (@handles)
  67.     {
  68.         $has_data = 1;
  69.     }
  70.    
  71.     return $has_data;
  72. }
  73.  
  74. sub atomd_kill_promt
  75. {
  76.     ($socket) = @_;
  77.  
  78.     while (atomd_data_available($socket))
  79.     {
  80.         $packet = atomd_read_packet($socket); # Read prompt
  81.     }
  82. }
  83.  
  84. sub atomd_initialize
  85. {
  86.     ($host, $port) = @_;
  87.     $socket = atomd_connect($host, $port);
  88.    
  89.     atomd_kill_promt($socket);
  90.    
  91.     return $socket;
  92. }
  93.  
  94.  
  95. sub atomd_send_command
  96. {
  97.     ($socket, $command) = @_;
  98.     atomd_write_packet($socket, "RESP", $command);
  99. }
  100.  
  101.  
  102. sub atomd_read_command_response
  103. {
  104.     ($socket) = @_;
  105.  
  106.     $response = "";
  107.  
  108.     while (1)
  109.     {
  110.         $packet = atomd_read_packet($socket);
  111.  
  112.         if (substr($packet, 0, 4) ne "TEXT")
  113.         {
  114.             last;
  115.         }
  116.  
  117.         $packet =~ s/\n//g;
  118. #       $response .= substr($packet, 8, -1);
  119.         $response .= substr($packet, 8);
  120.         $response .= "\n";
  121.     }
  122.  
  123.     return $response;
  124. }
  125.  
  126.  
  127. # Perl trim function to remove whitespace from the start and end of the string
  128. sub trim($)
  129. {
  130.     my $string = shift;
  131.     $string =~ s/^\s+//;
  132.     $string =~ s/\s+$//;
  133.     return $string;
  134. }
  135. # Left trim function to remove leading whitespace
  136. sub ltrim($)
  137. {
  138.     my $string = shift;
  139.     $string =~ s/^\s+//;
  140.     return $string;
  141. }
  142. # Right trim function to remove trailing whitespace
  143. sub rtrim($)
  144. {
  145.     my $string = shift;
  146.     $string =~ s/\s+$//;
  147.     return $string;
  148. }
  149.  
  150.  
  151.  
  152. # "return" 1 to not generate an error when loading file
  153. 1;
  154.  
  155.