From c7b205144779390ecbd78bf0068e1296aec68c79 Mon Sep 17 00:00:00 2001
From: rudolfkoenig <>
Date: Tue, 14 Aug 2018 20:14:09 +0000
Subject: [PATCH] 00_MQTT2_SERVER.pm: bugfixing (Forum #90145)
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@17140 2b470e98-0d58-463d-a4d8-8e2adae1ed80
---
FHEM/00_MQTT2_SERVER.pm | 14 ++++-
FHEM/10_MQTT2_DEVICE.pm | 114 ++++++----------------------------------
fhem.pl | 111 ++++++++++++++++++++++++++++++++++++++
3 files changed, 141 insertions(+), 98 deletions(-)
diff --git a/FHEM/00_MQTT2_SERVER.pm b/FHEM/00_MQTT2_SERVER.pm
index f6c870aea..01c55dbc2 100644
--- a/FHEM/00_MQTT2_SERVER.pm
+++ b/FHEM/00_MQTT2_SERVER.pm
@@ -2,7 +2,7 @@
# $Id$
package main;
-# TODO: save retain, Test SSL
+# TODO: autocreate, save retain, test SSL
use strict;
use warnings;
@@ -313,6 +313,18 @@ MQTT2_SERVER_Read($@)
}, undef, 0);
}
+ ####################################
+ } elsif($cpt eq "UNSUBSCRIBE") {
+ Log3 $sname, 4, "$cname $hash->{cid} $cpt";
+ my $pid = unpack('n', substr($pl, 0, 2));
+ my ($subscr, @ret);
+ $off = 2;
+ while($off < $tlen) {
+ ($subscr, $off) = MQTT2_SERVER_getStr($pl, $off);
+ delete $hash->{subscriptions}{$subscr};
+ Log3 $sname, 4, " topic:$subscr";
+ }
+ addToWritebuffer($hash, pack("CCn", 0xb0, 2, $pid)); # UNSUBACK
} elsif($cpt eq "PINGREQ") {
Log3 $sname, 4, "$cname $hash->{cid} $cpt";
diff --git a/FHEM/10_MQTT2_DEVICE.pm b/FHEM/10_MQTT2_DEVICE.pm
index 370e60f6e..85e9d646d 100644
--- a/FHEM/10_MQTT2_DEVICE.pm
+++ b/FHEM/10_MQTT2_DEVICE.pm
@@ -6,8 +6,6 @@ use strict;
use warnings;
use SetExtensions;
-sub MQTT2_JSON($;$);
-
sub
MQTT2_DEVICE_Initialize($)
{
@@ -84,7 +82,8 @@ MQTT2_DEVICE_Parse($$)
my $hash = $defs{$dev};
if($code =~ m/^{.*}$/s) {
- $code = EvalSpecials($code, ("%TOPIC"=>$topic, "%EVENT"=>$value));
+ $code = EvalSpecials($code,
+ ("%TOPIC"=>$topic, "%EVENT"=>$value, "%NAME"=>$hash->{NAME}));
my $ret = AnalyzePerlCommand(undef, $code);
if($ret && ref $ret eq "HASH") {
readingsBeginUpdate($hash);
@@ -114,10 +113,10 @@ MQTT2_DEVICE_Parse($$)
# PrioQueue_add(sub{
# return if(!$defs{$nn});
# if($value =~ m/^{.*}$/) {
-# my %ret = MQTT2_JSON($msg);
+# my %ret = json2nameValue($msg);
# if(keys %ret) {
# CommandAttr(undef,
-# "$nn readingList $cid:$topic:.* { MQTT2_JSON(\$EVENT) }");
+# "$nn readingList $cid:$topic:.* { json2nameValue(\$EVENT) }");
# }
# }
# $defs{$nn}{autocreated_on} = $msg;
@@ -130,91 +129,10 @@ MQTT2_DEVICE_Parse($$)
return @ret;
}
-#############################
-# simple json reading parser
sub
MQTT2_JSON($;$)
{
- my ($in,$prefix) = @_;
- $prefix = "" if(!defined($prefix));
- my %ret;
-
- sub
- lquote($)
- {
- my ($t) = @_;
- my $esc;
- for(my $off = 1; $off < length($t); $off++){
- my $s = substr($t,$off,1);
- if($s eq '\\') {
- $esc = !$esc;
- } elsif($s eq '"' && !$esc) {
- return (substr($t,1,$off-1), substr($t,$off+1));
- } else {
- $esc = 0;
- }
- }
- return ($t, ""); # error
- }
-
- sub
- lhash($)
- {
- my ($t) = @_;
- my $depth=1;
- my ($esc, $inquote);
-
- for(my $off = 1; $off < length($t); $off++){
- my $s = substr($t,$off,1);
- if($s eq '}') {
- $depth--;
- return (substr($t,1,$off-1), substr($t,$off+1)) if(!$depth);
-
- } elsif($s eq '{' && !$inquote) {
- $depth++;
-
- } elsif($s eq '"' && !$esc) {
- $inquote = !$inquote;
-
- } elsif($s eq '\\') {
- $esc = !$esc;
-
- } else {
- $esc = 0;
- }
- }
- return ($t, ""); # error
- }
-
- $in = $1 if($in =~ m/^{(.*)}$/s);
-
- while($in =~ m/^"([^"]+)"\s*:\s*(.*)$/s) {
- my ($name,$val) = ($1,$2);
- $name =~ s/[^a-z0-9._\-\/]/_/gsi;
-
- if($val =~ m/^"/) {
- ($val, $in) = lquote($val);
- $ret{"$prefix$name"} = $val;
-
- } elsif($val =~ m/^{/) { # }
- ($val, $in) = lhash($val);
- my $r2 = MQTT2_JSON($val);
- foreach my $k (keys %{$r2}) {
- $ret{"$prefix${name}_$k"} = $r2->{$k};
- }
-
- } elsif($val =~ m/^([0-9.-]+)(.*)$/s) {
- $ret{"$prefix$name"} = $1;
- $in = $2;
-
- } else {
- Log 1, "Error parsing $val";
- $in = "";
- }
-
- $in =~ s/^\s*,\s*//;
- }
- return \%ret;
+ return json2nameValue(@_);
}
@@ -244,7 +162,7 @@ MQTT2_DEVICE_Get($@)
shift @a;
if($cmd =~ m/^{.*}$/) {
- $cmd = EvalSpecials($cmd, ("%EVENT"=>join(" ",@a)));
+ $cmd = EvalSpecials($cmd, ("%EVENT"=>join(" ",@a), "%NAME"=>$hash->{NAME}));
$cmd = AnalyzeCommandChain($hash->{CL}, $cmd);
return if(!$cmd);
} else {
@@ -272,7 +190,8 @@ MQTT2_DEVICE_Set($@)
shift @a;
if($cmd =~ m/^{.*}$/) {
- $cmd = EvalSpecials($cmd, ("%EVENT"=>join(" ",@a)));
+ my $NAME = $hash->{NAME};
+ $cmd = EvalSpecials($cmd, ("%EVENT"=>join(" ",@a), "%NAME"=>$hash->{NAME}));
$cmd = AnalyzeCommandChain($hash->{CL}, $cmd);
return if(!$cmd);
} else {
@@ -290,10 +209,10 @@ MQTT2_DEVICE_Attr($$)
my ($type, $dev, $attrName, $param) = @_;
if($attrName =~ m/(.*)List/) {
- my $type = $1;
+ my $atype = $1;
if($type eq "del") {
- MQTT2_DEVICE_delReading($dev) if($type eq "reading");
+ MQTT2_DEVICE_delReading($dev) if($atype eq "reading");
return undef;
}
@@ -305,10 +224,10 @@ MQTT2_DEVICE_Attr($$)
(undef, $par2) = split(" ", $par2, 2) if($type eq "get");
return "$dev attr $attrName: more parameters needed" if(!$par2);
- if($type eq "reading") {
+ if($atype eq "reading") {
if($par2 =~ m/^{.*}$/) {
my $ret = perlSyntaxCheck($par2,
- ("%TOPIC"=>1, "%EVENT"=>"0 1 2 3 4 5 6 7 8 9"));
+ ("%TOPIC"=>1, "%EVENT"=>"0 1 2 3 4 5 6 7 8 9", "%NAME"=>$dev));
return $ret if($ret);
} else {
return "unsupported character in readingname $par2"
@@ -321,7 +240,7 @@ MQTT2_DEVICE_Attr($$)
}
}
- MQTT2_DEVICE_addReading($dev, $param) if($type eq "reading");
+ MQTT2_DEVICE_addReading($dev, $param) if($atype eq "reading");
}
return undef;
}
@@ -437,11 +356,12 @@ MQTT2_DEVICE_Undef($$)
available (the letter containing the whole message), as well as
$EVTPART0, $EVTPART1, ... each containing a single word of the
message.
- the helper function MQTT2_JSON($EVENT) can be used to parse a json
- encoded value. Importing all values from a Sonoff device with a
+ the helper function json2nameValue($EVENT) can be used to parse a
+ json encoded value. Importing all values from a Sonoff device with a
Tasmota firmware can be done with:
- attr sonoff_th10 readingList tele/sonoff/S.* { MQTT2_JSON($EVENT) }
+ attr sonoff_th10 readingList tele/sonoff/S.* {
+ json2nameValue($EVENT) }
diff --git a/fhem.pl b/fhem.pl
index abcb9eb1d..85a2aa206 100755
--- a/fhem.pl
+++ b/fhem.pl
@@ -130,6 +130,7 @@ sub getAllGets($;$);
sub getAllSets($;$);
sub getPawList($);
sub getUniqueId();
+sub json2nameValue($;$);
sub latin1ToUtf8($);
sub myrename($$$);
sub notifyRegexpChanged($$);
@@ -4873,6 +4874,116 @@ toJSON($)
}
}
+#############################
+# will return a hash of name:value pairs.
+# Note: doesnt know arrays, just objects and simple types
+sub
+json2nameValue($;$)
+{
+ my ($in,$prefix) = @_;
+ $prefix = "" if(!defined($prefix));
+ my %ret;
+
+ sub
+ lquote($)
+ {
+ my ($t) = @_;
+ my $esc;
+ for(my $off = 1; $off < length($t); $off++){
+ my $s = substr($t,$off,1);
+ if($s eq '\\') {
+ $esc = !$esc;
+ } elsif($s eq '"' && !$esc) {
+ return (substr($t,1,$off-1), substr($t,$off+1));
+ } else {
+ $esc = 0;
+ }
+ }
+ return ($t, ""); # error
+ }
+
+ sub
+ lhash($)
+ {
+ my ($t) = @_;
+ my $depth=1;
+ my ($esc, $inquote);
+
+ for(my $off = 1; $off < length($t); $off++){
+ my $s = substr($t,$off,1);
+ if($s eq '}') {
+ $depth--;
+ return (substr($t,1,$off-1), substr($t,$off+1)) if(!$depth);
+
+ } elsif($s eq '{' && !$inquote) {
+ $depth++;
+
+ } elsif($s eq '"' && !$esc) {
+ $inquote = !$inquote;
+
+ } elsif($s eq '\\') {
+ $esc = !$esc;
+
+ } else {
+ $esc = 0;
+ }
+ }
+ return ($t, ""); # error
+ }
+
+ $in = $1 if($in =~ m/^{(.*)}$/s);
+
+ while($in =~ m/^"([^"]+)"\s*:\s*(.*)$/s) {
+ my ($name,$val) = ($1,$2);
+ $name =~ s/[^a-z0-9._\-\/]/_/gsi;
+
+ if($val =~ m/^"/) {
+ ($val, $in) = lquote($val);
+ $ret{"$prefix$name"} = $val;
+
+ } elsif($val =~ m/^{/) { # }
+ ($val, $in) = lhash($val);
+ my $r2 = json2nameValue($val);
+ foreach my $k (keys %{$r2}) {
+ $ret{"$prefix${name}_$k"} = $r2->{$k};
+ }
+
+ } elsif($val =~ m/^([0-9.-]+)(.*)$/s) {
+ $ret{"$prefix$name"} = $1;
+ $in = $2;
+
+ } else {
+ Log 1, "Error parsing $val";
+ $in = "";
+ }
+
+ $in =~ s/^\s*,\s*//;
+ }
+ return \%ret;
+}
+
+# generate readings from the json string (parsed by json2reading) for $hash
+sub
+json2reading($$)
+{
+ my ($hash, $json) = @_;
+
+ $hash = $defs{$hash} if(ref($hash) ne "HASH");
+ return "json2reading: first arg is not a FHEM device"
+ if(!$hash || ref $hash ne "HASH" || !$hash->{TYPE});
+
+ my $ret = json2nameValue($json);
+ if($ret && ref $ret eq "HASH") {
+ readingsBeginUpdate($hash);
+ foreach my $k (keys %{$ret}) {
+ readingsBulkUpdate($hash, $k, $ret->{$k});
+ }
+ readingsEndUpdate($hash, 1);
+ }
+ return undef;
+}
+
+
sub
Debug($) {