############################################## # $Id$ package main; use strict; use warnings; use SetExtensions; sub MQTT2_DEVICE_Initialize($) { my ($hash) = @_; $hash->{Match} = ".*"; $hash->{SetFn} = "MQTT2_DEVICE_Set"; $hash->{GetFn} = "MQTT2_DEVICE_Get"; $hash->{DefFn} = "MQTT2_DEVICE_Define"; $hash->{UndefFn} = "MQTT2_DEVICE_Undef"; $hash->{AttrFn} = "MQTT2_DEVICE_Attr"; $hash->{ParseFn} = "MQTT2_DEVICE_Parse"; $hash->{RenameFn} = "MQTT2_DEVICE_Rename"; $hash->{FW_detailFn} = "MQTT2_DEVICE_fhemwebFn"; $hash->{FW_deviceOverview} = 1; no warnings 'qw'; my @attrList = qw( IODev autocreate:0,1 bridgeRegexp:textField-long devicetopic devPos disable:0,1 disabledForIntervals getList:textField-long imageLink jsonMap:textField-long model readingList:textField-long setList:textField-long setStateList ); use warnings 'qw'; $hash->{AttrList} = join(" ", @attrList)." ".$readingFnAttributes; my %h = ( re=>{}, cid=>{}, bridge=>{} ); $modules{MQTT2_DEVICE}{defptr} = \%h; # Create cache directory my $fn = $attr{global}{modpath}."/www/deviceimages"; if(! -d $fn) { mkdir($fn) || Log 3, "Can't create $fn"; } $fn .= "/mqtt2"; if(! -d $fn) { mkdir($fn) || Log 3, "Can't create $fn"; } } ############################# sub MQTT2_DEVICE_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); my $name = shift @a; my $type = shift @a; # always MQTT2_DEVICE $hash->{CID} = shift(@a) if(@a); return "wrong syntax for $name: define MQTT2_DEVICE [clientid]" if(int(@a)); $hash->{DEVICETOPIC} = $name; if($hash->{CID}) { my $dpc = $modules{MQTT2_DEVICE}{defptr}{cid}; if(!$dpc->{$hash->{CID}}) { $dpc->{$hash->{CID}} = []; } push(@{$dpc->{$hash->{CID}}},$hash); } AssignIoPort($hash); return undef; } ############################# sub MQTT2_DEVICE_Parse($$) { my ($iodev, $msg) = @_; my $ioname = $iodev->{NAME}; my %fnd; sub checkForGet($$$) { my ($hash, $key, $value) = @_; if($hash->{asyncGet} && $key eq $hash->{asyncGet}{reading}) { RemoveInternalTimer($hash->{asyncGet}); asyncOutput($hash->{asyncGet}{CL}, "$key $value"); delete($hash->{asyncGet}); } } my $autocreate = "no"; if($msg =~ m/^autocreate=([^\0]+)\0(.*)$/s) { $autocreate = $1; $msg = $2; } my ($cid, $topic, $value) = split("\0", $msg, 3); my $dp = $modules{MQTT2_DEVICE}{defptr}{re}; foreach my $re (keys %{$dp}) { my $reAll = $re; $reAll =~ s/\$DEVICETOPIC/\.\*/g; next if(!("$topic:$value" =~ m/^$reAll$/s || "$cid:$topic:$value" =~ m/^$reAll$/s)); foreach my $key (keys %{$dp->{$re}}) { my ($dev, $code2) = split(",",$key,2); my $hash = $defs{$dev}; next if(!$hash); next if(IsDisabled($dev)); my $reRepl = $re; $reRepl =~ s/\$DEVICETOPIC/$hash->{DEVICETOPIC}/g; next if(!("$topic:$value" =~ m/^$reRepl$/s || "$cid:$topic:$value" =~ m/^$reRepl$/s)); my @retData; my $code = $dp->{$re}{$key}; Log3 $dev, 4, "MQTT2_DEVICE_Parse: $dev $topic => $code"; if($code =~ m/^{.*}$/s) { $code = EvalSpecials($code, ("%TOPIC"=>$topic, "%EVENT"=>$value, "%DEVICETOPIC"=>$hash->{DEVICETOPIC}, "%NAME"=>$hash->{NAME}, "%JSONMAP","\$defs{$dev}{JSONMAP}")); my $ret = AnalyzePerlCommand(undef, $code); if($ret && ref $ret eq "HASH") { readingsBeginUpdate($hash); foreach my $k (keys %{$ret}) { readingsBulkUpdate($hash, $k, $ret->{$k}); my $msg = ($ret->{$k} ? $ret->{$k} : ""); push(@retData, "$k $msg"); checkForGet($hash, $k, $ret->{$k}); } readingsEndUpdate($hash, 1); } } else { readingsSingleUpdate($hash, $code, $value, 1); push(@retData, "$code $value"); checkForGet($hash, $code, $value); } $fnd{$dev} = 1; } } ################################################# # IODevs autocreate and/or expand readingList if($autocreate ne "no" && !%fnd) { return "" if($cid && $cid =~ m/mosqpub.*/); ################## bridge stuff my $newCid = $cid; my $bp = $modules{MQTT2_DEVICE}{defptr}{bridge}; my $parentBridge; my %matching; # For debugging foreach my $re (keys %{$bp}) { next if(!("$topic:$value" =~ m/^$re$/s || "$cid:$topic:$value" =~ m/^$re$/s)); my $cidExpr = $bp->{$re}{name}; $newCid = eval $cidExpr; if($@) { Log 1, "MQTT2_DEVICE: Error evaluating $cidExpr: $@"; return ""; } $parentBridge = $bp->{$re}{parent}; $matching{$re} = 1; } return if(!$newCid); if(int(keys %matching) > 1) { Log 1, "MULTIPLE MATCH in bridgeRegexp for $cid:$topic:$value: ". join(",",keys %matching); } PrioQueue_add(sub{ my $cidArr = $modules{MQTT2_DEVICE}{defptr}{cid}{$newCid}; return if(!$cidArr); my $add; if($value =~ m/^{.*}$/s) { my $ret = json2nameValue($value); if(keys %{$ret}) { $topic =~ m,.*/([^/]+),; my $ltopic = makeReadingName($1)."_"; $add = $autocreate eq "simple" ? "{ json2nameValue(\$EVENT) }" : "{ json2nameValue(\$EVENT, '$ltopic', \$JSONMAP) }"; } } if(!$add) { my @tEl = split("/",$topic); if(@tEl == 1) { $add = $tEl[0]; } elsif($tEl[-1] =~ m/^\d+$/) { # relay_0 $add = $tEl[-2]."_".$tEl[-1]; } elsif($tEl[-2] =~ m/^\d+$/) { # relay_0_power $add = $tEl[-2]."_".$tEl[-1]; $add = $tEl[-3]."_".$add if(@tEl > 2); } else { $add = $tEl[-1]; } $add = makeReadingName($add); # Convert non-valid characters to _ } $topic =~ s,([\^\$\[\]()\.\\]),\\$1,g; for my $ch (@{$cidArr}) { my $nn = $ch->{NAME}; next if(!AttrVal($nn, "autocreate", 1)); # device autocreate my $rl = AttrVal($nn, "readingList", ""); $rl .= "\n" if($rl); my $regex = ($cid eq $newCid ? "$cid:" : "").$topic.":.*"; CommandAttr(undef, "$nn readingList $rl$regex $add") if(index($rl, $regex) == -1); # Forum #84372 setReadingsVal($defs{$nn}, "associatedWith", $parentBridge, TimeNow()) if($parentBridge && $defs{$nn}); } MQTT2_DEVICE_Parse($iodev, $msg); }, undef); my $cidArr = $modules{MQTT2_DEVICE}{defptr}{cid}{$newCid}; if(!$cidArr || !int(@{$cidArr})) { my $devName = $newCid; $devName = makeDeviceName($devName); return "UNDEFINED MQTT2_$devName MQTT2_DEVICE $newCid"; } return ""; } my @ret = keys %fnd; unshift(@ret, "[NEXT]"); # for MQTT_GENERIC_BRIDGE return @ret; } # compatibility: the first version was implemented as MQTT2_JSON and published. sub MQTT2_JSON($;$) { return json2nameValue($_[0], $_[1]); } sub MQTT2_getCmdHash($) { my ($list) = @_; my (%h, @cmd); map { my ($k,$v) = split(" ",$_,2); push @cmd, $k; $k =~ s/:.*//; # potential arguments $h{$k} = $v; } grep /./, split("\n", $list); return (\%h, join(" ",@cmd)); } ############################# # replace {} and $EVENT. Used both in set and get sub MQTT2_buildCmd($$$) { my ($hash, $a, $cmd) = @_; shift @{$a}; if($cmd =~ m/^{.*}$/) { $cmd = EvalSpecials($cmd, ("%EVENT" => join(" ",@{$a}), "%NAME" => $hash->{NAME}, "%DEVICETOPIC" => $hash->{DEVICETOPIC})); $cmd = AnalyzeCommandChain($hash->{CL}, $cmd); return if(!$cmd); } else { if($cmd =~ m/\$EV/) { # replace EVENT & $EVTPART my $event = join(" ",@{$a}); $cmd =~ s/\$EVENT/$event/g; for(my $i=0; $i<@{$a}; $i++) { my $n = "\\\$EVTPART$i"; $cmd =~ s/$n/$a->[$i]/ge; } } else { shift @{$a}; $cmd .= " ".join(" ",@{$a}) if(@{$a}); } $cmd =~ s/\$NAME/$hash->{NAME}/g; $cmd =~ s/\$DEVICETOPIC/$hash->{DEVICETOPIC}/g; } return $cmd; } ############################# sub MQTT2_DEVICE_Get($@) { my ($hash, @a) = @_; return "Not enough arguments for get" if(!defined($a[1])); my ($gets,$cmdList) = MQTT2_getCmdHash(AttrVal($hash->{NAME}, "getList", "")); return "Unknown argument $a[1], choose one of $cmdList" if(!$gets->{$a[1]}); return undef if(IsDisabled($hash->{NAME})); my ($getReading, $cmd) = split(" ",$gets->{$a[1]},2); if($hash->{CL}) { my $tHash = { hash=>$hash, CL=>$hash->{CL}, reading=>$getReading }; $hash->{asyncGet} = $tHash; InternalTimer(gettimeofday()+4, sub { asyncOutput($tHash->{CL}, "Timeout reading answer for $cmd"); delete($hash->{asyncGet}); }, $tHash, 0); } $cmd = MQTT2_buildCmd($hash, \@a, $cmd); return if(!$cmd); IOWrite($hash, "publish", $cmd); return undef; } ############################# sub MQTT2_DEVICE_Set($@) { my ($hash, @a) = @_; return "Not enough arguments for set" if(!defined($a[1])); my ($sets,$cmdList) = MQTT2_getCmdHash(AttrVal($hash->{NAME}, "setList", "")); my $cmdName = $a[1]; return MQTT2_DEVICE_addPos($hash,@a) if($cmdName eq "addPos"); # hidden cmd my $cmd = $sets->{$cmdName}; return SetExtensions($hash, $cmdList, @a) if(!$cmd); return undef if(IsDisabled($hash->{NAME})); $cmd = MQTT2_buildCmd($hash, \@a, $cmd); return if(!$cmd); IOWrite($hash, "publish", $cmd); my $ssl = AttrVal($hash->{NAME}, "setStateList", ""); if(!$ssl) { readingsSingleUpdate($hash, "state", $cmdName, 1); } else { if($ssl =~ m/\b$cmdName\b/) { $hash->{skipStateFormat} = 1; readingsSingleUpdate($hash, "state", "set_$cmdName", 1); delete($hash->{skipStateFormat}); } else { shift(@a); unshift(@a, "set"); readingsSingleUpdate($hash, $cmdName, join(" ",@a), 1); } } return undef; } sub MQTT2_DEVICE_Attr($$) { my ($type, $dev, $attrName, $param) = @_; my $hash = $defs{$dev}; if($attrName eq "devicetopic") { $hash->{DEVICETOPIC} = ($type eq "del" ? $hash->{NAME} : $param); return undef; } if($attrName =~ m/(.*)List/) { my $atype = $1; if($type eq "del") { MQTT2_DEVICE_delReading($dev) if($atype eq "reading"); return undef; } return "$dev attr $attrName: more parameters needed" if(!$param); #90145 foreach my $el (split("\n", $param)) { my ($par1, $par2) = split(" ", $el, 2); next if(!$par1); (undef, $par2) = split(" ", $par2, 2) if($type eq "get"); return "$dev attr $attrName: more parameters needed" if(!$par2); if($atype eq "reading") { if($par2 =~ m/^{.*}$/) { my $ret = perlSyntaxCheck($par2, ("%TOPIC"=>1, "%EVENT"=>"0 1 2 3 4 5 6 7 8 9", "%NAME"=>$dev, "%DEVICETOPIC"=>$hash->{DEVICETOPIC}, "%JSONMAP"=>"")); return $ret if($ret); } else { return "bad reading name $par2 ". "(contains not A-Za-z/\\d_\\.- or is too long)" if(!goodReadingName($par2)); } } else { my $ret = perlSyntaxCheck($par2, ("%NAME"=>$dev, "%EVENT"=>"0 1 2 3 4 5 6 7 8 9", "%DEVICETOPIC"=>$dev)); return $ret if($ret); } } if($atype eq "reading") { my $ret = MQTT2_DEVICE_addReading($dev, $param); return $ret if($ret); } } if($attrName eq "bridgeRegexp" && $type eq "set") { my $old = AttrVal($dev, "bridgeRegexp", ""); foreach my $el (split("\n", $old)) { my ($par1, $par2) = split(" ", $el, 2); delete($modules{MQTT2_DEVICE}{defptr}{bridge}{$par1}) if($par1); } foreach my $el (split("\n", $param)) { my ($par1, $par2) = split(" ", $el, 2); next if(!$par1); return "$dev attr $attrName: more parameters needed" if(!$par2); eval { "Hallo" =~ m/^$par1$/ }; return "$dev $attrName regexp error: $@" if($@); $modules{MQTT2_DEVICE}{defptr}{bridge}{$par1}= {name=>$par2,parent=>$dev}; } if($init_done) { my $name = $hash->{NAME}; AnalyzeCommandChain(undef, "deleteattr $name readingList; deletereading $name .*"); } } if($attrName eq "jsonMap") { if($type eq "set") { my @ret = split(/[: \r\n]/, $param); return "jsonMap: Odd number of elements" if(int(@ret) % 2); my %ret = @ret; $hash->{JSONMAP} = \%ret; } else { delete $hash->{JSONMAP}; } } return undef; } sub MQTT2_DEVICE_delReading($) { my ($name) = @_; my $dp = $modules{MQTT2_DEVICE}{defptr}{re}; foreach my $re (keys %{$dp}) { foreach my $key (keys %{$dp->{$re}}) { if($key =~ m/^$name,/) { delete($dp->{$re}{$key}); delete($dp->{$re}) if(!int(keys %{$dp->{$re}})); } } } } sub MQTT2_DEVICE_addReading($$) { my ($name, $param) = @_; MQTT2_DEVICE_delReading($name); foreach my $line (split("\n", $param)) { my ($re,$code) = split(" ", $line,2); eval { "Hallo" =~ m/^$re$/ }; return "Bad regexp: $@" if($@); $modules{MQTT2_DEVICE}{defptr}{re}{$re}{"$name,$code"} = $code if($re && $code); } return undef; } ##################################### sub MQTT2_DEVICE_Rename($$) { my ($new, $old) = @_; MQTT2_DEVICE_delReading($old); MQTT2_DEVICE_addReading($new, AttrVal($new, "readingList", "")); $defs{$new}{DEVICETOPIC} = $new; return undef; } ##################################### sub MQTT2_DEVICE_Undef($$) { my ($hash, $arg) = @_; MQTT2_DEVICE_delReading($arg); if($hash->{CID}) { my $dpc = $modules{MQTT2_DEVICE}{defptr}{cid}{$hash->{CID}}; my @nh = grep { $_->{NAME} ne $hash->{NAME} } @{$dpc}; $modules{MQTT2_DEVICE}{defptr}{cid}{$hash->{CID}} = \@nh; } return undef; } ##################################### # Reuse the ZWDongle map for graphvis visualisation. Forum #91394 sub MQTT2_DEVICE_fhemwebFn($$$$) { my ($FW_wname, $d, $room, $pageHash) = @_; # pageHash is set for summaryFn. if(ReadingsVal($d, ".graphviz", ReadingsVal($d, "graphviz", ""))) { my $js = "$FW_ME/pgm2/zwave_neighborlist.js"; return "
Show neighbor map
". "
". "". ' JSEND } my $img = AttrVal($d, "imageLink", ""); if($img) { return "
". "". "
". ' JSEND } } ######################### # Used for the graphical representation in Bridge devices. See Fn above. sub MQTT2_DEVICE_nlData($) { my ($d) = @_; my (%img,%h,%n2n); my $fo=""; #my $pref = "https://koenkk.github.io/zigbee2mqtt/images/devices/"; my $pref = "https://www.zigbee2mqtt.io/images/devices/"; # Needed for the image links my $dv = ReadingsVal($d, ".devices", ReadingsVal($d, "devices", "")); $dv =~ s@ieeeAddr":"([^"]+)"[^}]+model":"([^"]+)"@ my $img = $2; $img =~ s+[/: ]+-+g; # Forum #91394: supported-devices.js $img{$1} = "$img.jpg"; @xeg; # Name translation for my $n (devspec2array("TYPE=MQTT2_DEVICE")) { my $cid = $defs{$n}{CID}; if($cid) { $cid =~ s/zigbee_//; $n2n{$cid} = $n; } if(AttrVal($n, "readingList","") =~ m,zigbee2mqtt/(.*):,) { $n2n{$1} = $n; } } my $div = ($FW_userAgent =~ m/WebKit/ ? "
" : " "); my $gv = ReadingsVal($d, ".graphviz", ReadingsVal($d, "graphviz", "")); for my $l (split(/[\r\n]/, $gv)) { if($l =~ m/^\s*"([^"]+)"\s*\[.*label="([^"]+)"\]/) { my ($n,$v) = ($1,$2); my $nv = $n; $nv =~ s/^0x0*//; $h{$n}{img} = ''; if($v =~ m/{(.*)\|(.*)\|(.*)\|(.*)}/) { my ($x1,$x2,$x3,$x4) = ($1,$2,$3,$4); $nv = $n2n{$x1} if($n2n{$x1}); if($img{$n}) { my $fn = $attr{global}{modpath}."/www/deviceimages/mqtt2/$img{$n}"; if(!-f $fn) { # Cache the picture my $url = "$pref/$img{$n}"; Log 3, "MQTT2_DEVICE: downloading $url to $fn"; my $data = GetFileFromURL($url); if($data && open(FH,">$fn")) { binmode(FH); print FH $data; close(FH) } } $h{$n}{img} = "$FW_ME/deviceimages/mqtt2/$img{$n}"; } if($img{$n} && $n2n{$x1} && !AttrVal($n2n{$x1}, "imageLink", "")) { CommandAttr(undef, "$nv imageLink $h{$n}{img}"); } $h{$n}{class} = ($x2 =~ m/Coordinator|Router/ ? "zwDongle":"zwBox"); if($x2 =~ m/Coordinator/) { $nv = $d; $fo = $n; } } else { $h{$n}{class}="zwBox"; } $v =~ s/[{}]//g; $v =~ s/\|/$div/g; $h{$n}{txt} = $nv; $h{$n}{title} = $v; $fo = $n if(!$fo); my @a; $h{$n}{neighbors} = \@a; } elsif($l =~ m/^\s*"([^"]+)"\s*->\s*"([^"]+)"\s\[label="([^"]*)"/) { push @{$h{$1}{neighbors}}, $2; $h{$1}{title} .= "${div}lqi:$3"; } } my @ret; my @dp = split(" ", AttrVal($d, "devPos", "")); my %dp = @dp; for my $k (keys %h) { my $n = $h{$k}{neighbors}; push @ret, '"'.$k.'":{'. '"class":"'.$h{$k}{class}.' col_link col_oddrow",'. '"img":"'.$h{$k}{img}.'",'. '"txt":"'.$h{$k}{txt}.'",'. '"title":"'.$h{$k}{title}.'",'. '"pos":['.($dp{$k} ? $dp{$k} : '').'],'. '"neighbors":['. (@{$n} ? ('"'.join('","',@{$n}).'"'):'').']}'; } my $r = '{"firstObj":"'.$fo.'","el":{'.join(",",@ret).'},'. '"saveFn":"set '.$d.' addPos {1} {2}" }'; return $r; } sub MQTT2_DEVICE_addPos($@) { my ($hash, @a) = @_; my @d = split(" ", AttrVal($a[0], "devPos", "")); my %d = @d; $d{$a[2]} = $a[3]; CommandAttr(undef,"$a[0] devPos ".join(" ", map {"$_ $d{$_}"} sort keys %d)); } # graphvis end ##################################### ##################################### # Utility functions for the AttrTemplates sub zigbee2mqtt_RGB2JSON($) { my $rgb = shift(@_); $rgb =~ m/^(..)(..)(..)/; return toJSON({'transition'=>1, 'color'=>{r=>hex($1),g=>hex($2),b=>hex($3)}}); } sub zigbee2mqtt_devStateIcon255($) { my ($name) = @_; return ".*:off:toggle" if(lc(ReadingsVal($name,"state","ON")) eq "off" ); my $pct = ReadingsNum($name,"brightness","255"); my $s = $pct > 253 ? "on" : sprintf("dim%02d%%",int((1+int($pct/18))*6.25)); return ".*:$s:off"; } 1; =pod =item summary devices communicating via the MQTT2_SERVER or MQTT2_CLIENT =item summary_DE über den MQTT2_SERVER oder MQTT2_CLIENT kommunizierende Geräte =begin html

MQTT2_DEVICE

=end html =cut