90_EIBUPDOWN.pm 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212
  1. ##############################################
  2. package main;
  3. use strict;
  4. use warnings;
  5. my %eib_c2b1 = (
  6. "alloff" => "00",
  7. "off" => "01",
  8. "on" => "00",
  9. "up" => "01",
  10. "down" => "00",
  11. "up-for-timer" => "01",
  12. "down-for-timer" => "00",
  13. );
  14. my %eib_c2b2 = (
  15. "alloff" => "00",
  16. "off" => "00",
  17. "on" => "01",
  18. "up" => "00",
  19. "down" => "01",
  20. "up-for-timer" => "00",
  21. "down-for-timer" => "01",
  22. );
  23. my %readonly = (
  24. "dummy" => 1,
  25. );
  26. my $eib_simple ="alloff off on up down up-for-timer down-for-timer";
  27. my %models = (
  28. );
  29. sub
  30. EIBUPDOWN_Initialize($)
  31. {
  32. my ($hash) = @_;
  33. $hash->{Match} = "^B.*";
  34. $hash->{SetFn} = "EIBUPDOWN_Set";
  35. $hash->{StateFn} = "EIBUPDOWN_SetState";
  36. $hash->{DefFn} = "EIBUPDOWN_Define";
  37. $hash->{UndefFn} = "EIBUPDOWN_Undef";
  38. $hash->{ParseFn} = "EIBUPDOWN_Parse";
  39. $hash->{AttrList} = "IODev do_not_notify:1,0 ignore:0,1 dummy:1,0 showtime:1,0 model:EIB loglevel:0,1,2,3,4,5,6";
  40. }
  41. #############################
  42. sub
  43. EIBUPDOWN_Define($$)
  44. {
  45. my ($hash, $def) = @_;
  46. my @a = split("[ \t][ \t]*", $def);
  47. my $u = "wrong syntax: define <name> EIBUPDOWN <up group name> <down group name>";
  48. return $u if(int(@a) < 4);
  49. return "Define $a[0]: wrong up group name format: specify as 0-255/0-255/0-255"
  50. if( ($a[2] !~ m/^[0-9]{1,3}\/[0-9]{1,3}\/[0-9]{1,3}$/i));
  51. return "Define $a[0]: wrong down group name format: specify as 0-255/0-255/0-255"
  52. if( ($a[3] !~ m/^[0-9]{1,3}\/[0-9]{1,3}\/[0-9]{1,3}$/i));
  53. my $groupname_up = eibupdown_name2hex($a[2]);
  54. my $groupname_down = eibupdown_name2hex($a[3]);
  55. $hash->{GROUP_UP} = lc($groupname_up);
  56. $hash->{GROUP_DOWN} = lc($groupname_down);
  57. my $code = "$groupname_up$groupname_down";
  58. my $ncode = 1;
  59. my $name = $a[0];
  60. $hash->{CODE}{$ncode++} = $code;
  61. $modules{EIB}{defptr}{$code}{$name} = $hash;
  62. AssignIoPort($hash);
  63. }
  64. #############################
  65. sub
  66. EIBUPDOWN_Undef($$)
  67. {
  68. my ($hash, $name) = @_;
  69. foreach my $c (keys %{ $hash->{CODE} } ) {
  70. $c = $hash->{CODE}{$c};
  71. # As after a rename the $name may be different from the $defptr{$c}{$n}
  72. # we look for the hash.
  73. foreach my $dname (keys %{ $modules{EIB}{defptr}{$c} }) {
  74. delete($modules{EIB}{defptr}{$c}{$dname})
  75. if($modules{EIB}{defptr}{$c}{$dname} == $hash);
  76. }
  77. }
  78. return undef;
  79. }
  80. #####################################
  81. sub
  82. EIBUPDOWN_SetState($$$$)
  83. {
  84. my ($hash, $tim, $vt, $val) = @_;
  85. $val = $1 if($val =~ m/^(.*) \d+$/);
  86. return "Undefined value $val" if(!defined($eib_c2b1{$val}));
  87. return undef;
  88. }
  89. ###################################
  90. sub
  91. EIBUPDOWN_Set($@)
  92. {
  93. my ($hash, @a) = @_;
  94. my $ret = undef;
  95. my $na = int(@a);
  96. return "no set value specified" if($na < 2 || $na > 3);
  97. return "Readonly value $a[1]" if(defined($readonly{$a[1]}));
  98. my $c_off = $eib_c2b1{"alloff"};
  99. my $c_up = $eib_c2b1{$a[1]};
  100. my $c_down = $eib_c2b2{$a[1]};
  101. if(!defined($c_off) || !defined($c_up) || !defined($c_down)) {
  102. return "Unknown argument $a[1], choose one of " .
  103. join(" ", sort keys %eib_c2b1);
  104. }
  105. my $v = join(" ", @a);
  106. Log GetLogLevel($a[0],2), "EIB set $v";
  107. (undef, $v) = split(" ", $v, 2); # Not interested in the name...
  108. # first of all switch off all channels
  109. # just for being sure
  110. IOWrite($hash, "B", "w" . $hash->{GROUP_UP} . $c_off);
  111. select(undef,undef,undef,0.5);
  112. IOWrite($hash, "B", "w" . $hash->{GROUP_DOWN} . $c_off);
  113. select(undef,undef,undef,0.5);
  114. # now switch on the right channel
  115. if($c_up ne $c_off) {
  116. IOWrite($hash, "B", "w" . $hash->{GROUP_UP} . $c_up);
  117. }
  118. elsif($c_down ne $c_off) {
  119. IOWrite($hash, "B", "w" . $hash->{GROUP_DOWN} . $c_down);
  120. }
  121. ###########################################
  122. # Delete any timer for on-for_timer
  123. if($modules{EIB}{ldata}{$a[0]}) {
  124. CommandDelete(undef, $a[0] . "_timer");
  125. delete $modules{EIB}{ldata}{$a[0]};
  126. }
  127. ###########################################
  128. # Add a timer if any for-timer command has been chosen
  129. if($a[1] =~ m/for-timer/ && $na == 3) {
  130. my $dur = $a[2];
  131. my $to = sprintf("%02d:%02d:%02d", $dur/3600, ($dur%3600)/60, $dur%60);
  132. $modules{EIB}{ldata}{$a[0]} = $to;
  133. Log 4, "Follow: +$to set $a[0] alloff";
  134. CommandDefine(undef, $a[0] . "_timer at +$to set $a[0] alloff");
  135. }
  136. ##########################
  137. # Look for all devices with the same code, and set state, timestamp
  138. my $code = "$hash->{GROUP_UP}$hash->{GROUP_DOWN}";
  139. my $tn = TimeNow();
  140. foreach my $n (keys %{ $modules{EIB}{defptr}{$code} }) {
  141. my $lh = $modules{EIB}{defptr}{$code}{$n};
  142. $lh->{CHANGED}[0] = $v;
  143. $lh->{STATE} = $v;
  144. $lh->{READINGS}{state}{TIME} = $tn;
  145. $lh->{READINGS}{state}{VAL} = $v;
  146. }
  147. return $ret;
  148. }
  149. sub
  150. EIBUPDOWN_Parse($$)
  151. {
  152. my ($hash, $msg) = @_;
  153. Log(5,"EIBUPDOWN_Parse is not defined. msg: $msg");
  154. }
  155. #############################
  156. sub
  157. eibupdown_name2hex($)
  158. {
  159. my $v = shift;
  160. my $r = $v;
  161. Log(5, "name2hex: $v");
  162. if($v =~ /^([0-9]{1,2})\/([0-9]{1,2})\/([0-9]{1,3})$/) {
  163. $r = sprintf("%01x%01x%02x",$1,$2,$3);
  164. }
  165. elsif($v =~ /^([0-9]{1,2})\.([0-9]{1,2})\.([0-9]{1,3})$/) {
  166. $r = sprintf("%01x%01x%02x",$1,$2,$3);
  167. }
  168. return $r;
  169. }
  170. 1;