11_OWX_TCP.pm 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853
  1. ########################################################################################
  2. #
  3. # OWX_TCP.pm
  4. #
  5. # FHEM module providing hardware dependent functions for the
  6. # TCP/IP-UART interfaces of OWX connected to a DS2480
  7. #
  8. # Prof. Dr. Peter A. Henning
  9. #
  10. # $Id: 11_OWX_TCP.pm 15392 2017-11-05 06:46:46Z phenning $
  11. #
  12. ########################################################################################
  13. #
  14. # Provides the following methods for OWX
  15. #
  16. # Define
  17. # Detect
  18. # Alarms
  19. # Complex
  20. # Discover
  21. # Init
  22. # Read
  23. # Ready
  24. # Reset
  25. # Verify
  26. # Write
  27. # Query
  28. # First
  29. # Next
  30. # Search
  31. # SearchLow
  32. #
  33. ########################################################################################
  34. #
  35. # $hash->{DeviceName} = <ip-addresse>:port
  36. # $hash->{INTERFACE} = "DS2480";
  37. # $hash->{TYPE} = "OWX";
  38. #
  39. ########################################################################################
  40. package OWX_TCP;
  41. use strict;
  42. use warnings;
  43. use DevIo;
  44. ########################################################################################
  45. #
  46. # Constructor
  47. #
  48. ########################################################################################
  49. sub new($) {
  50. my ($class,$hash) = @_;
  51. return bless {
  52. #-- OWX device
  53. hash => $hash,
  54. #-- 16 byte search string
  55. search => [0,0,0,0 ,0,0,0,0, 0,0,0,0, 0,0,0,0],
  56. ROM_ID => [0,0,0,0 ,0,0,0,0],
  57. #-- search state for 1-Wire bus search
  58. LastDiscrepancy => 0,
  59. LastFamilyDiscrepancy => 0,
  60. LastDeviceFlag => 0,
  61. }, $class;
  62. }
  63. ########################################################################################
  64. #
  65. # Define - Implements Define method
  66. #
  67. # Parameter def = definition string
  68. #
  69. # Return undef if ok, otherwise error message
  70. #
  71. ########################################################################################
  72. sub Define ($) {
  73. my ($self,$def) = @_;
  74. my $hash = $self->{hash};
  75. my @a = split("[ \t][ \t]*", $def);
  76. my $dev = $a[2];
  77. my @tcp = split(':',$dev);
  78. my $ip = $tcp[0];
  79. my $port= ( $tcp[1] )?$tcp[1]:23;
  80. #-- store with OWX device
  81. $hash->{DeviceName} = $ip.":".$port;
  82. $hash->{ASYNCHRONOUS} = 0;
  83. #-- module version
  84. $hash->{version} = "7.05";
  85. main::Log3 $hash->{NAME},1,"OWX_TCP::Define warning: version ".$hash->{version}." not identical to OWX version "..$main::owx_version
  86. if( $hash->{version} ne $main::owx_version );
  87. #-- call low level init function for the device
  88. $self->Init();
  89. return undef;
  90. }
  91. ########################################################################################
  92. #
  93. # Detect - Find out if we have the proper interface
  94. #
  95. # Return 1 if ok, otherwise 0
  96. #
  97. ########################################################################################
  98. sub Detect () {
  99. my ($self) = @_;
  100. my $hash = $self->{hash};
  101. my ($i,$j,$k,$l,$res,$ret,$ress);
  102. my $name = $hash->{NAME};
  103. my $ress0 = "OWX_TCP::Detect 1-Wire bus $name: interface ";
  104. $ress = $ress0;
  105. my $interface;
  106. #-- timing byte for DS2480
  107. $self->Query("\xC1",1);
  108. #-- Max 4 tries to detect an interface
  109. for($l=0;$l<4;$l++) {
  110. #-- write 1-Wire bus (Fig. 2 of Maxim AN192)
  111. $res = $self->Query("\x17\x45\x5B\x0F\x91",5);
  112. #-- process 4/5-byte string for detection
  113. if( !defined($res)){
  114. $res="";
  115. $ret=0;
  116. }elsif( ($res eq "\x16\x44\x5A\x00") || ($res eq "\x16\x44\x5A\x00\x90") || ($res eq "\x16\x44\x5A\x00\x93")){
  117. $ress .= "master DS2480 detected for the first time";
  118. $interface="DS2480";
  119. $ret=1;
  120. } elsif( ($res eq "\x17\x45\x5B\x0F\x91") || ($res eq "\x17\x45\x1B\x0F\x91")){
  121. $ress .= "master DS2480 re-detected";
  122. $interface="DS2480";
  123. $ret=1;
  124. } else {
  125. $ret=0;
  126. }
  127. last
  128. if( $ret==1 );
  129. main::OWX_WDBGL($name,1,$ress."not found, answer was ",$res);
  130. $ress = $ress0;
  131. }
  132. if( $ret == 0 ){
  133. $interface=undef;
  134. main::OWX_WDBGL($name,1,$ress."not detected, answer was ",$res);
  135. } else {
  136. main::OWX_WDBGL($name,1,$ress,undef);
  137. }
  138. $hash->{INTERFACE} = $interface;
  139. return $ret;
  140. }
  141. ########################################################################################
  142. #
  143. # Alarms - Find devices on the 1-Wire bus, which have the alarm flag set
  144. #
  145. # Return number of alarmed devices
  146. #
  147. ########################################################################################
  148. sub Alarms () {
  149. my ($self) = @_;
  150. my $hash = $self->{hash};
  151. my $name = $hash->{NAME};
  152. #-- Discover all alarmed devices on the 1-Wire bus
  153. #main::Log3 $name, 1, "We ARE ASKING FOR ALARMS - WHY NOT ASK THE LAST RESET THING ? ";
  154. my $res = $self->First("alarm");
  155. while( $self->{LastDeviceFlag}==0 && $res != 0){
  156. $res = $res & $self->SER_Next("alarm");
  157. }
  158. if( $hash->{ALARMDEVS} ) {
  159. main::Log3 $name, 1, " Alarms = ".join(' ',@{$hash->{ALARMDEVS}});
  160. return( int(@{$hash->{ALARMDEVS}}) );
  161. } else {
  162. return 0;
  163. }
  164. }
  165. ########################################################################################
  166. #
  167. # Complex - Send match ROM, data block and receive bytes as response
  168. #
  169. # Parameter hash = hash of bus master,
  170. # owx_dev = ROM ID of device
  171. # data = string to send
  172. # numread = number of bytes to receive
  173. #
  174. # Return response, if OK
  175. # 0 if not OK
  176. #
  177. ########################################################################################
  178. sub Complex ($$$$) {
  179. my ($self,$dev,$data,$numread) =@_;
  180. my $hash = $self->{hash};
  181. my $name = $hash->{NAME};
  182. my $select;
  183. my $res;
  184. #-- has match ROM part
  185. if( $dev ){
  186. #-- ID of the device
  187. my $owx_rnf = substr($dev,3,12);
  188. my $owx_f = substr($dev,0,2);
  189. #-- 8 byte 1-Wire device address
  190. my @rom_id =(0,0,0,0 ,0,0,0,0);
  191. #-- from search string to byte id
  192. $dev=~s/\.//g;
  193. for(my $i=0;$i<8;$i++){
  194. $rom_id[$i]=hex(substr($dev,2*$i,2));
  195. }
  196. $select=sprintf("\x55%c%c%c%c%c%c%c%c",@rom_id).$data;
  197. #-- has no match ROM part
  198. } else {
  199. $select=$data;
  200. }
  201. #-- has receive data part
  202. if( $numread >0 ){
  203. #$numread += length($data);
  204. for( my $i=0;$i<$numread;$i++){
  205. $select .= "\xFF";
  206. };
  207. }
  208. main::OWX_WDBGL($name,5,"OWX_TCP::Complex sending ",$select);
  209. #-- send data block (Fig. 6 of Maxim AN192)
  210. my $data2="";
  211. my $retlen = length($select);
  212. #-- if necessary, prepend E1 character for data mode
  213. if( substr($select,0,1) ne '\xE1') {
  214. $data2 = "\xE1";
  215. }
  216. #-- all E3 characters have to be duplicated
  217. for(my $i=0;$i<length($select);$i++){
  218. my $newchar = substr($select,$i,1);
  219. $data2=$data2.$newchar;
  220. if( $newchar eq '\xE3'){
  221. $data2=$data2.$newchar;
  222. }
  223. }
  224. #-- write 1-Wire bus as a single string
  225. $res =$self->Query($data2,$retlen);
  226. main::OWX_WDBGL($name,5,"OWX_TCP::Complex receiving ",$res);
  227. return $res
  228. }
  229. ########################################################################################
  230. #
  231. # Discover - Find devices on the 1-Wire bus
  232. #
  233. # Return 1, if alarmed devices found, 0 otherwise.
  234. #
  235. ########################################################################################
  236. sub Discover () {
  237. my ($self) = @_;
  238. my $hash = $self->{hash};
  239. #-- zero the array
  240. @{$hash->{DEVS}}=();
  241. #-- Discover all devices on the 1-Wire bus
  242. my $res = $self->First("discover");
  243. while( $self->{LastDeviceFlag}==0 && $res!=0 ){
  244. $res = $res & $self->Next("discover");
  245. }
  246. return( @{$hash->{DEVS}} == 0);
  247. }
  248. ########################################################################################
  249. #
  250. # Init - Implement the Init function. Only reopens the device
  251. #
  252. # Return undef if ok
  253. #
  254. ########################################################################################
  255. sub Init() {
  256. my ($self) = @_;
  257. my $hash = $self->{hash};
  258. my $dev = $hash->{DeviceName};
  259. my $name = $hash->{NAME};
  260. main::Log3 $name, 5,"OWX_TCP::Init called on device $dev for bus $name, state is ".$hash->{STATE};
  261. main::DevIo_OpenDev($hash,0,undef);
  262. return undef;
  263. }
  264. #######################################################################################
  265. #
  266. # Read - Implement the Read function
  267. #
  268. # Parameter numexp = expected number of bytes
  269. #
  270. #######################################################################################
  271. sub Read(@) {
  272. my ($self,$numexp) = @_;
  273. my $hash = $self->{hash};
  274. my $name = $hash->{NAME};
  275. my $buffer = "";
  276. #-- first try to read things
  277. $buffer = main::DevIo_SimpleRead($hash);
  278. return $buffer;
  279. }
  280. ########################################################################################
  281. #
  282. # Ready - Implement the Ready function
  283. #
  284. # Return 1 : OK
  285. # 0 : not OK
  286. #
  287. ########################################################################################
  288. sub Ready () {
  289. my ($self) = @_;
  290. my $hash = $self->{hash};
  291. my $name = $hash->{NAME};
  292. my $success= 0;
  293. main::Log3 $name,5,"OWX_TCP: Ready function called for bus $name. STATE=".$hash->{STATE};
  294. if($hash->{STATE} eq "disconnected"){
  295. $success = main::DevIo_OpenDev($hash,1,"main::OWX_Init");
  296. #main::Log3 $name,5," ===============> success = $success";
  297. if( !$success ){
  298. main::DevIo_CloseDev($hash);
  299. $success = main::DevIo_OpenDev($hash,1,"main::OWX_Init");
  300. #main::Log3 $name,5," 2nd try ===============> success = $success";
  301. }
  302. }
  303. return $success;
  304. }
  305. ########################################################################################
  306. #
  307. # Reset - Reset the 1-Wire bus (Fig. 4 of Maxim AN192)
  308. #
  309. # Return 1 : OK
  310. # 0 : not OK
  311. #
  312. ########################################################################################
  313. sub Reset () {
  314. my ($self)=@_;
  315. my $hash = $self->{hash};
  316. my $name = $hash->{NAME};
  317. my $interface = $hash->{TYPE};
  318. my $asynchronous = $hash->{ASYNCHRONOUS};
  319. return 0
  320. if( $hash->{STATE} eq "disconnected" );
  321. my ($res,$r1,$r2);
  322. #-- Reset command
  323. my $cmd = "\xE3\xC5";
  324. #-- OWX interface
  325. if( $interface eq "OWX" ){
  326. $res = $self->Query($cmd,1);
  327. $res = "" if( !$res );
  328. #-- OWX_ASYNC
  329. }elsif( $interface eq "OWX_ASYNC"){
  330. $res = $self->Query($cmd,1);
  331. $res = "" if( !$res );
  332. }
  333. #-- process result
  334. $r1 = ord(substr($res,0,1)) & 192;
  335. if( $r1 != 192){
  336. main::OWX_WDBGL($name,4,"OWX_TCP::Reset_TCP failure on bus $name ",$res);
  337. return 0;
  338. }
  339. $hash->{ALARMED} = "no";
  340. $r2 = ord(substr($res,0,1)) & 3;
  341. if( $r2 == 3 ){
  342. main::Log3($name,4, "OWX_TCP: No presence detected on bus $name");
  343. return 1;
  344. }elsif( $r2 ==2 ){
  345. main::Log3($name,1, "OWX_TCP: Reset_TCP Alarm presence detected on bus $name");
  346. $hash->{ALARMED} = "yes";
  347. }
  348. return 1;
  349. }
  350. ########################################################################################
  351. #
  352. # Query - Sychronously write to and read from the 1-Wire bus
  353. #
  354. # Parameter: cmd = string to send to the 1-Wire bus
  355. #
  356. # Return: string received from the 1-Wire bus
  357. #
  358. ########################################################################################
  359. sub Query ($$) {
  360. my ($self,$cmd,$numexp) = @_;
  361. my $hash = $self->{hash};
  362. my $name = $hash->{NAME};
  363. my $state = $hash->{STATE};
  364. my $timeout = $hash->{timeout};
  365. my $timedout = 0;
  366. my $try = 0;
  367. my $buffer = "";
  368. my $numget = 0;
  369. my $numgeto = 0;
  370. if($state ne "opened") {
  371. main::Log3 $name, 1, "OWX_TCP::Query attempted to write to $state device $name";
  372. return undef;
  373. }
  374. #-- write operation
  375. main::OWX_WDBGL($name,5,"OWX_TCP::Query $name: Sending out",$cmd);
  376. return undef unless defined(main::DevIo_SimpleWrite($hash, $cmd, 0));
  377. #-- sleeping for some time
  378. select(undef,undef,undef,0.04);
  379. #-- first try to read things
  380. eval {
  381. local $SIG{ALRM} = sub { die "alarm\n" };
  382. alarm 1;
  383. $buffer = main::DevIo_DoSimpleRead($hash);
  384. alarm 0;
  385. };
  386. if ($@) {
  387. if( $numexp<=1 ){
  388. main::Log3 $name, 4, "OWX_TCP::Query timed out in first attempt - maybe one byte missing";
  389. return "";
  390. }
  391. main::Log3 $name, 4, "OWX_TCP::Query timed out in first attempt";
  392. $timedout = 1;
  393. }
  394. $numget = (defined($buffer))?length($buffer):0;
  395. $numgeto = $numget;
  396. #-- first try ok
  397. if( $numget >= $numexp){
  398. main::Log3 $name, 5, "OWX_TCP::Query $name: Received $numget of $numexp bytes in first attempt and state $state";
  399. return $buffer;
  400. #-- several tries to read from slow device
  401. }elsif( $numget<$numexp ){
  402. for($try=0;$try<3;$try++) {
  403. eval {
  404. local $SIG{ALRM} = sub { die "alarm\n" };
  405. alarm $timeout;
  406. $buffer .= main::DevIo_DoSimpleRead($hash);
  407. alarm 0;
  408. };
  409. if ($@) {
  410. main::Log3 $name, 4, "OWX_TCP::Query timed out in loop attempt no. $try";
  411. }
  412. $numget = length($buffer);
  413. last
  414. if( $numget>=$numexp );
  415. select(undef,undef,undef,0.01);
  416. }
  417. main::Log3 $name, 5, "OWX_TCP::Query $name: $numget of $numexp bytes in loop $try and state $state"
  418. if( $numget < $numexp );
  419. return $buffer
  420. if( $numget >= $numexp);
  421. }
  422. #-- something wrong with the 1-Wire device
  423. if( ($numget == $numgeto) && ($timedout==0) ){
  424. main::Log3 $name, 1,"OWX_TCP::Query $name: $numget of $numexp bytes - something wrong with the 1-Wire device ???";
  425. return $buffer;
  426. #-- ultimate failure
  427. }else{
  428. main::OWX_WDBGL($name,5,"OWX_TCP::Query $name: $numget of $numexp bytes in last attempt and state $state. ",$buffer);
  429. main::DevIo_Disconnected($hash);
  430. main::InternalTimer(main::gettimeofday()+$timeout, "main::OWX_Ready", $hash,0);
  431. return $buffer;
  432. }
  433. }
  434. ########################################################################################
  435. #
  436. # Verify - Verify a particular device on the 1-Wire bus
  437. #
  438. # Parameter dev = 8 Byte ROM ID of device to be tested
  439. #
  440. # Return 1 : device found
  441. # 0 : device not
  442. #
  443. ########################################################################################
  444. sub Verify ($) {
  445. my ($self,$dev) = @_;
  446. my $hash = $self->{hash};
  447. my @rom_id;
  448. my $i;
  449. #-- from search string to byte id
  450. my $devs=$dev;
  451. $devs=~s/\.//g;
  452. for($i=0;$i<8;$i++){
  453. $rom_id[$i]=hex(substr($devs,2*$i,2));
  454. }
  455. @{$self->{ROM_ID}}=@rom_id;
  456. #-- reset the search state
  457. $self->{LastDiscrepancy} = 64;
  458. $self->{LastDeviceFlag} = 0;
  459. #-- now do the search
  460. my $res=$self->Search("verify");
  461. my $dev2=sprintf("%02X.%02X%02X%02X%02X%02X%02X.%02X",@{$self->{ROM_ID}});
  462. #-- reset the search state
  463. $self->{LastDiscrepancy} = 0;
  464. $self->{LastDeviceFlag} = 0;
  465. #-- check result
  466. if ($dev eq $dev2){
  467. return 1;
  468. }else{
  469. return 0;
  470. }
  471. }
  472. #######################################################################################
  473. #
  474. # Write - Implement the write function
  475. #
  476. #
  477. # Parameter cmd = string to be sent
  478. # reset = 1 if initial bus reset has to be done
  479. #
  480. ########################################################################################
  481. sub Write(@) {
  482. my ($self,$cmd, $reset) = @_;
  483. my $hash = $self->{hash};
  484. my $name = $hash->{NAME};
  485. if($hash->{STATE} eq "disconnected"){
  486. main::Log3 $name,1,"OWX_TCP::Write attempted to disconnected device $name";
  487. return undef;
  488. }
  489. #-- if necessary, perform a reset operation
  490. $self->Reset()
  491. if( $reset );
  492. #-- if necessary, prepend E1 character for data mode of DS2480
  493. my $cmd2 = ( substr($cmd,0,1) ne '\xE1')?"\xE1":"";
  494. #-- all E3 characters have to be duplicated in DS2480
  495. for(my $i=0;$i<length($cmd);$i++){
  496. my $newchar = substr($cmd,$i,1);
  497. $cmd2=$cmd2.$newchar;
  498. if( $newchar eq '\xE3'){
  499. $cmd2=$cmd2.$newchar;
  500. }
  501. }
  502. main::OWX_WDBGL($name,5,"OWX_TCP::Write Sending out ",$cmd2);
  503. main::DevIo_SimpleWrite($hash, $cmd2, 0);
  504. return;
  505. }
  506. #######################################################################################
  507. #
  508. # First - Find the 'first' devices on the 1-Wire bus
  509. #
  510. # Parameter mode
  511. #
  512. # Return 1 : device found, ROM number pushed to list
  513. # 0 : no device present
  514. #
  515. ########################################################################################
  516. sub First ($) {
  517. my ($self,$mode) = @_;
  518. #-- clear 16 byte of search data
  519. @{$self->{search}} = (0,0,0,0 ,0,0,0,0, 0,0,0,0, 0,0,0,0);
  520. #-- reset the search state
  521. $self->{LastDiscrepancy} = 0;
  522. $self->{LastDeviceFlag} = 0;
  523. $self->{LastFamilyDiscrepancy} = 0;
  524. #-- now do the search
  525. return $self->Search($mode);
  526. }
  527. ########################################################################################
  528. #
  529. # Next - Find the 'next' devices on the 1-Wire bus
  530. #
  531. # Parameter hash = hash of bus master, mode
  532. #
  533. # Return 1 : device found, ROM number in owx_ROM_ID and pushed to list (LastDeviceFlag=0)
  534. # or only in owx_ROM_ID (LastDeviceFlag=1)
  535. # 0 : device not found, or ot searched at all
  536. #
  537. ########################################################################################
  538. sub Next ($) {
  539. my ($self,$mode) = @_;
  540. return $self->Search($mode);
  541. }
  542. #######################################################################################
  543. #
  544. # Search - Perform the 1-Wire Search Algorithm on the 1-Wire bus using the existing
  545. # search state.
  546. #
  547. # Parameter mode=alarm,discover or verify
  548. #
  549. # Return 1 : device found, ROM number in owx_ROM_ID and pushed to list (LastDeviceFlag=0)
  550. # or only in owx_ROM_ID (LastDeviceFlag=1)
  551. # 0 : device not found, or ot searched at all
  552. #
  553. ########################################################################################
  554. sub Search ($) {
  555. my ($self,$mode)=@_;
  556. my $hash = $self->{hash};
  557. my $name = $hash->{NAME};
  558. my @owx_fams=();
  559. #TODO: What if undefined ?
  560. #-- if the last call was the last one, no search
  561. if ($self->{LastDeviceFlag}==1){
  562. return 0;
  563. }
  564. #-- 1-Wire reset
  565. if ($self->Reset()==0){
  566. #-- reset the search
  567. main::Log(1, "OWX_TCP::Search reset failed on bus $name");
  568. $self->{LastDiscrepancy} = 0;
  569. $self->{LastDeviceFlag} = 0;
  570. $self->{LastFamilyDiscrepancy} = 0;
  571. return 0;
  572. }
  573. #-- here we call the device dependent part
  574. $self->SearchLow($mode);
  575. #--check if we really found a device
  576. if( main::OWX_CRC($self->{ROM_ID})!= 0){
  577. #-- reset the search
  578. main::Log(1, "OWX_TCP::Search CRC failed on bus $name");
  579. $self->{LastDiscrepancy} = 0;
  580. $self->{LastDeviceFlag} = 0;
  581. $self->{LastFamilyDiscrepancy} = 0;
  582. return 0;
  583. }
  584. #-- character version of device ROM_ID, first byte = family
  585. my $dev=sprintf("%02X.%02X%02X%02X%02X%02X%02X.%02X",@{$self->{ROM_ID}});
  586. #-- for some reason this does not work - replaced by another test, see below
  587. #if( $self->{LastDiscrepancy}==0 ){
  588. # $self->{LastDeviceFlag}=1;
  589. #}
  590. #--
  591. if( $self->{LastDiscrepancy}==$self->{LastFamilyDiscrepancy} ){
  592. $self->{LastFamilyDiscrepancy}=0;
  593. }
  594. #-- mode was to verify presence of a device
  595. if ($mode eq "verify") {
  596. main::Log(5, "OWX_TCP::Search: device verified $dev on bus $name");
  597. return 1;
  598. #-- mode was to discover devices
  599. } elsif( $mode eq "discover" ){
  600. #-- check families
  601. my $famfnd=0;
  602. foreach (@owx_fams){
  603. if( substr($dev,0,2) eq $_ ){
  604. #-- if present, set the fam found flag
  605. $famfnd=1;
  606. last;
  607. }
  608. }
  609. push(@owx_fams,substr($dev,0,2)) if( !$famfnd );
  610. foreach (@{$hash->{DEVS}}){
  611. if( $dev eq $_ ){
  612. #-- if present, set the last device found flag
  613. $self->{LastDeviceFlag}=1;
  614. last;
  615. }
  616. }
  617. if( $self->{LastDeviceFlag}!=1 ){
  618. #-- push to list
  619. push(@{$hash->{DEVS}},$dev);
  620. main::Log(5, "OWX_TCP::Search: new device found $dev on bus $name");
  621. }
  622. return 1;
  623. #-- mode was to discover alarm devices
  624. } elsif( $hash->{ALARMDEVS} ) {
  625. for(my $i=0;$i<@{$hash->{ALARMDEVS}};$i++){
  626. if( $dev eq ${$hash->{ALARMDEVS}}[$i] ){
  627. #-- if present, set the last device found flag
  628. $self->{LastDeviceFlag}=1;
  629. last;
  630. }
  631. }
  632. if( $self->{LastDeviceFlag}!=1 ){
  633. #--push to list
  634. push(@{$hash->{ALARMDEVS}},$dev);
  635. main::Log(5, "OWX_TCP::Search: new alarm device found $dev on bus $name");
  636. }
  637. return 1;
  638. }
  639. }
  640. ########################################################################################
  641. #
  642. # SearchLow - Perform the 1-Wire Search Algorithm on the 1-Wire bus using the existing
  643. # search state.
  644. #
  645. # Parameter mode=alarm,discover or verify
  646. #
  647. # Return 1 : device found, ROM number in owx_ROM_ID and pushed to list (LastDeviceFlag=0)
  648. # or only in owx_ROM_ID (LastDeviceFlag=1)
  649. # 0 : device not found, or ot searched at all
  650. #
  651. ########################################################################################
  652. sub SearchLow ($) {
  653. my ($self,$mode)=@_;
  654. my $hash = $self->{hash};
  655. my $name = $hash->{NAME};
  656. my ($sp1,$sp2,$response,$search_direction,$id_bit_number);
  657. #-- Response search data parsing operates bytewise
  658. $id_bit_number = 1;
  659. select(undef,undef,undef,0.05);
  660. #-- clear 16 byte of search data
  661. @{$self->{search}}=(0,0,0,0 ,0,0,0,0, 0,0,0,0, 0,0,0,0);
  662. #-- Output search data construction (Fig. 9 of Maxim AN192)
  663. # operates on a 16 byte search response = 64 pairs of two bits
  664. while ( $id_bit_number <= 64) {
  665. #-- address single bits in a 16 byte search string
  666. my $newcpos = int(($id_bit_number-1)/4);
  667. my $newimsk = ($id_bit_number-1)%4;
  668. #-- address single bits in a 8 byte id string
  669. my $newcpos2 = int(($id_bit_number-1)/8);
  670. my $newimsk2 = ($id_bit_number-1)%8;
  671. if( $id_bit_number <= $self->{LastDiscrepancy}){
  672. #-- first use the ROM ID bit to set the search direction
  673. if( $id_bit_number < $self->{LastDiscrepancy} ) {
  674. $search_direction = (@{$self->{ROM_ID}}[$newcpos2]>>$newimsk2) & 1;
  675. #-- at the last discrepancy search into 1 direction anyhow
  676. } else {
  677. $search_direction = 1;
  678. }
  679. #-- fill into search data;
  680. @{$self->{search}}[$newcpos]+=$search_direction<<(2*$newimsk+1);
  681. }
  682. #--increment number
  683. $id_bit_number++;
  684. }
  685. #-- issue data mode \xE1, the normal search command \xF0 or the alarm search command \xEC
  686. # and the command mode \xE3 / start accelerator \xB5
  687. if( $mode ne "alarm" ){
  688. $sp1 = "\xE1\xF0\xE3\xB5";
  689. } else {
  690. $sp1 = "\xE1\xEC\xE3\xB5";
  691. }
  692. #-- issue data mode \xE1, device ID, command mode \xE3 / end accelerator \xA5
  693. $sp2=sprintf("\xE1%c%c%c%c%c%c%c%c%c%c%c%c%c%c%c%c\xE3\xA5",@{$self->{search}});
  694. $response = $self->Query($sp1,1);
  695. $response = $self->Query($sp2,16);
  696. #-- interpret the return data
  697. if( length($response)!=16 ) {
  698. main::Log(3, "OWX_TCP::Search_TCP on bus $name 2nd return has wrong parameter with length = ".length($response)."");
  699. return 0;
  700. }
  701. #-- Response search data parsing (Fig. 11 of Maxim AN192)
  702. # operates on a 16 byte search response = 64 pairs of two bits
  703. $id_bit_number = 1;
  704. #-- clear 8 byte of device id for current search
  705. @{$self->{ROM_ID}} =(0,0,0,0 ,0,0,0,0);
  706. while ( $id_bit_number <= 64) {
  707. #-- adress single bits in a 16 byte string
  708. my $newcpos = int(($id_bit_number-1)/4);
  709. my $newimsk = ($id_bit_number-1)%4;
  710. #-- retrieve the new ROM_ID bit
  711. my $newchar = substr($response,$newcpos,1);
  712. #-- these are the new bits
  713. my $newibit = (( ord($newchar) >> (2*$newimsk) ) & 2) / 2;
  714. my $newdbit = ( ord($newchar) >> (2*$newimsk) ) & 1;
  715. #-- output for test purpose
  716. #print "id_bit_number=$id_bit_number => newcpos=$newcpos, newchar=0x".int(ord($newchar)/16).
  717. # ".".int(ord($newchar)%16)." r$id_bit_number=$newibit d$id_bit_number=$newdbit\n";
  718. #-- discrepancy=1 and ROM_ID=0
  719. if( ($newdbit==1) and ($newibit==0) ){
  720. $self->{LastDiscrepancy}=$id_bit_number;
  721. if( $id_bit_number < 9 ){
  722. $self->{LastFamilyDiscrepancy}=$id_bit_number;
  723. }
  724. }
  725. #-- fill into device data; one char per 8 bits
  726. @{$self->{ROM_ID}}[int(($id_bit_number-1)/8)]+=$newibit<<(($id_bit_number-1)%8);
  727. #-- increment number
  728. $id_bit_number++;
  729. }
  730. return 1;
  731. }
  732. 1;
  733. =pod
  734. =item device
  735. =item summary to address an OWX interface device via TCP/IP
  736. =item summary_DE zur Adressierung eines OWX Interface Device mit TCP/IP
  737. =begin html
  738. <a name="OWX_TCP"></a>
  739. <h3>OWX_TCP</h3>
  740. See <a href="/fhem/docs/commandref.html#OWX">OWX</a>
  741. =end html
  742. =begin html_DE
  743. <a name="OWX_TCP"></a>
  744. <h3>OWX_TCP</h3>
  745. <a href="http://fhemwiki.de/wiki/Interfaces_f%C3%BCr_1-Wire">Deutsche Dokumentation im Wiki</a> vorhanden, die englische Version gibt es hier: <a href="/fhem/docs/commandref.html#OWX">OWX</a>
  746. =end html_DE