Subversion Repositories HomeAutomation

Rev

Rev 518 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | SVN | RSS feed

  1. #!/usr/bin/perl -w
  2. use IO::Socket;
  3. use integer;
  4. use threads;
  5.  
  6. #for sending time msg: set to 1, else set to 0
  7. $sendtime = 0;
  8.  
  9. #for printing timestamps on printed messages: set to 1, else set to 0
  10. $timestamp = 1;
  11.  
  12. #define filters for id of messages, passed messages will be printed on stdout
  13. @acceptmask_ones =  (0x00080000, 0x00240000, 0x00040000);
  14. @acceptmask_zeros = (0xfff70000, 0xffdb0000, 0xfffb0000);
  15. @denymask_ones = ();
  16. @denymask_zeros = ();
  17.  
  18. #define makros, when an input sting is sent on can this perl-script will send the corresponding output string
  19. @input =   ("PKT 04000005 1 0 00 00 05 01");
  20. @output =  ("PKT 0a100601 1 0 03"         );
  21.  
  22.  
  23.  
  24. $remote = IO::Socket::INET->new(
  25.                     Proto    => "tcp",
  26.                     PeerAddr => "localhost",
  27.                     PeerPort => "1200",
  28.                 )
  29.                or die "cannot connect to port 1200 at localhost";
  30.  
  31. if ($sendtime == 1) {
  32.     $thr = threads->new(\&sendTime);
  33.     $thr->detach;
  34. }
  35.  
  36. $acceptmask_ones = @acceptmask_ones;
  37. $acceptmask_zeros = @acceptmask_zeros;
  38. if ($acceptmask_ones != $acceptmask_zeros) {
  39.     print "Acceptmasks must be same length\n";
  40.     exit;
  41. }
  42.  
  43. $denymask_ones = @denymask_ones;
  44. $denymask_zeros = @denymask_zeros;
  45. if ($denymask_ones != $denymask_zeros) {
  46.     print "Denymasks must be same length\n";
  47.     exit;
  48. }
  49.  
  50. #get the lengths of the makro arrays:
  51. $input = @input;
  52. $output = @output;
  53. if ($input != $output) {
  54.     print "Input and output makros must be same length\n";
  55.     exit;
  56. }
  57.  
  58. #read line from socket (blocking)
  59. while ( $line = <$remote> ) {
  60.     if (length($line) > 12) {
  61.         $id = hex(substr($line, 4, 8));
  62.        
  63.         #macro function
  64.         for ($i = 0; $i < $input; $i++) {
  65.             if ($input[$i] eq substr($line, 0, length($input[$i]))) {
  66.                 print $remote $output[$i];
  67.             }
  68.         }
  69.        
  70.         $printed = 0;
  71.         $denied = 0;
  72.         #filter function
  73.         for ($i = 0; $i < $acceptmask_ones && !$printed && !$denied; $i++) {
  74.             if ((($id & $acceptmask_ones[$i])==$acceptmask_ones[$i]) && (($id & $acceptmask_zeros[$i])==0)) {
  75.                 #check if denied by $denymask
  76.                 for ($j = 0; $j < $denymask_ones; $j++) {
  77.                     if ((($id & $denymask_ones[$j])==$denymask_ones[$j]) && (($id & $denymask_zeros[$j])==0)) {
  78.                         #this message fits the denymask
  79.                         $denied = 1;
  80.                     }
  81.                    
  82.                 }
  83.                
  84.                 if (!$denied) {
  85.                     #print timestamp
  86.                     if ($timestamp == 1) {
  87.                         print localtime()." ";
  88.                     }
  89.                     print $line;
  90.                    
  91.                     $printed = 1;
  92.                 }
  93.             }
  94.         }
  95.     }
  96. }
  97.  
  98. sub sendTime {
  99.     $remote = IO::Socket::INET->new(
  100.                     Proto    => "tcp",
  101.                     PeerAddr => "localhost",
  102.                     PeerPort => "1200",
  103.                 )
  104.                or die "cannot connect to port 1200 at localhost";
  105.    
  106.     while (1) {
  107.         select(undef, undef, undef, 0.5);
  108.         print $remote "PKT 00000000 1 0";
  109.     }
  110. }
  111.