Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-01 20:20:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

99_valetudoUtils.pm:some code cleanup,handle decode_json croaks on error

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@25558 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
Otto123 2022-01-25 11:32:05 +00:00
parent efe7bbab53
commit 370cf611bc
1 changed files with 100 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

254
contrib/AttrTemplate/99_valetudoUtils.pm
View File

@ -8,186 +8,132 @@ package main;
use strict; use strict;
use warnings; use warnings;
use JSON;Dumper;
sub sub
valetudoUtils_Initialize { valetudoUtils_Initialize {
my $hash = shift; my $hash = shift;
return; return;
} }
# Enter you functions below _this_ line. # Enter you functions below _this_ line.
#######
# decode_json() croaks on error, this function should prevent fhem crashes
# https://metacpan.org/pod/Perl::Critic::Policy::ErrorHandling::RequireCheckingReturnValueOfEval
sub decode_j {
use JSON qw(decode_json);
my $maybe_json = shift;
my $data;
if ( eval { $data = decode_json($maybe_json); 1 } ) { return $data }
Log3(undef, 1, "JSON decoding error, >$maybe_json< seems not to be valid JSON data: $@");
return q{}
}
####### #######
# return a string for dynamic selection setList (widgets) # return a string for dynamic selection setList (widgets)
sub valetudo_w { sub valetudo_w {
my $NAME = shift; my $NAME = shift;
my $setter = shift; my $setter = shift;
# this part reads segments, it's only filled if Provide map data is enabled in connectivity # this part reads segments, it's only filled if Provide map data is enabled in connectivity
if ($setter eq 'segments') { if ($setter eq 'segments') {
my $json = ReadingsVal($NAME,'.segments','{}'); my $json = ReadingsVal($NAME,'.segments','{}');
if ($json eq '{}') {$json = '{"1":"no_Segment_or_not_supported"}'}; if ($json eq '{}') {$json = '{"1":"no_Segment_or_not_supported"}'};
my $decoded = decode_json($json); my $decoded = decode_j($json);
return join ',', sort values %$decoded return join ',', sort values %{$decoded}
} }
# this part read presets which contains a full json for preset zones or locations # this part read presets which contains a full json for preset zones or locations
if ($setter eq 'zones' or $setter eq 'locations') { if ($setter eq 'zones' or $setter eq 'locations') {
my $json = ReadingsVal($NAME,'.'.$setter.'Presets',''); my $json = ReadingsVal($NAME,'.'.$setter.'Presets',q{});
my $decoded = decode_json($json); my $decoded = decode_j($json);
my @array; my @array;
for (keys %$decoded) { push @array, $decoded->{$_}->{'name'} } for ( keys %{$decoded} ) { push @array, $decoded->{$_}->{'name'} }
return join',',@array return join ',', sort @array
} }
# this part is for study purpose to read the full json segments with the REST API like # this part is for study purpose to read the full json segments with the REST API like
# setreading alias=DreameL10pro json_segments {(qx(wget -qO - http://192.168.90.21/api/v2/robot/capabilities/MapSegmentationCapability))} # setreading alias=DreameL10pro json_segments {(qx(wget -qO - http://192.168.90.21/api/v2/robot/capabilities/MapSegmentationCapability))}
if ($setter eq 'json_segments') { if ($setter eq 'json_segments') {
my $json = ReadingsVal($NAME,'json_segments','select'); my $json = ReadingsVal($NAME,'json_segments','select');
my $decoded = decode_json($json); my $decoded = decode_j($json);
my @array=@{$decoded}; my @array=@{$decoded};
my %t; my %t;
for (@array) { $t{$_->{'name'}} = $_->{'id'} } for (@array) { $t{$_->{'name'}} = $_->{'id'} }
return join ',', sort keys %t return join ',', sort keys %t
} }
} }
####### #######
# valetudo_c return a complete string for setList right part # valetudo_c return a complete string for setList right part
sub valetudo_c { sub valetudo_c {
my $NAME = shift; my $NAME = shift;
my $EVENT = shift; my ($cmd,$load) = split q{ }, shift, 2;
my $ret = 'error'; my $ret = 'error';
my ($cmd,$load) = split(q{ }, $EVENT,2); my $devicetopic = InternalVal($NAME,'DEVICETOPIC',"valetudo/$NAME");
my $devicetopic = InternalVal($NAME,'DEVICETOPIC',"valetudo/$NAME");
# x_raw_payload like # x_raw_payload like
# /MapSegmentationCapability/clean/set {"segment_ids":["6"],"iterations":1,"customOrder":true} # /MapSegmentationCapability/clean/set {"segment_ids":["6"],"iterations":1,"customOrder":true}
if ($cmd eq 'x_raw_payload') {$ret=$devicetopic.$load} if ($cmd eq 'x_raw_payload') { $ret=$devicetopic.$load }
# this part return an array of segment id's according to selected Names from segments (simple json) # this part return an array of segment id's according to selected Names from segments (simple json)
if ($cmd eq 'clean_segment') { if ($cmd eq 'clean_segment') {
my @rooms = split',', $load; my @rooms = split ',', $load;
my $json = ReadingsVal($NAME,'.segments',''); my $json = ReadingsVal($NAME,'.segments',q{});
my $decoded = decode_json($json); my $decoded = decode_j($json);
my @ids; my @ids;
for ( @rooms ) { push @ids,{reverse %$decoded}->{$_} } for ( @rooms ) { push @ids, {reverse %{$decoded} }->{$_} }
my %Hcmd = ( clean_segment => {segment_ids => \@ids,iterations => 1,customOrder => 'true' } ); my %Hcmd = ( clean_segment => {segment_ids => \@ids,iterations => 1,customOrder => 'true' } );
$ret = $devicetopic.'/MapSegmentationCapability/clean/set '.toJSON $Hcmd{$cmd} $ret = $devicetopic.'/MapSegmentationCapability/clean/set '.toJSON $Hcmd{$cmd}
} }
# this part return the zone/location id according to the selected Name from presets (zones/locations) (more complex json) # this part return the zone/location id according to the selected Name from presets (zones/locations) (more complex json)
if ($cmd eq 'clean_zone') { if ($cmd eq 'clean_zone') {
my $json = ReadingsVal($NAME,'.zonesPresets',''); my $json = ReadingsVal($NAME,'.zonesPresets',q{});
my $decoded = decode_json($json); my $decoded = decode_j($json);
for (keys %$decoded) { for (keys %{$decoded}) {
if ( $decoded->{$_}->{'name'} eq $load ) {$ret = $devicetopic.'/ZoneCleaningCapability/start/set '.$_ } if ( $decoded->{$_}->{'name'} eq $load ) {$ret = $devicetopic.'/ZoneCleaningCapability/start/set '.$_ }
} }
} }
if ($cmd eq 'goto') { if ($cmd eq 'goto') {
my $json = ReadingsVal($NAME,'.locationsPresets',''); my $json = ReadingsVal($NAME,'.locationsPresets',q{});
my $decoded = decode_json($json); my $decoded = decode_j($json);
for (keys %$decoded) { for (keys %{$decoded}) {
if ( $decoded->{$_}->{'name'} eq $load ) {$ret = $devicetopic.'/GoToLocationCapability/go/set '.$_ } if ( $decoded->{$_}->{'name'} eq $load ) {$ret = $devicetopic.'/GoToLocationCapability/go/set '.$_ }
} }
} }
# this part is for study purpose to read the full json segments with the REST API # this part is for study purpose to read the full json segments with the REST API
# this part return an array of segment id's according to selected Names from json_segments (complex json) # this part return an array of segment id's according to selected Names from json_segments (complex json)
if ($cmd eq 'clean_segment_j') { if ($cmd eq 'clean_segment_j') {
$cmd = 'clean_segment'; # only during Test $cmd = 'clean_segment'; # only during Test
my @rooms = split',', $load; my @rooms = split ',', $load;
my $json = ReadingsVal($NAME,'json_segments',''); my $json = ReadingsVal($NAME,'json_segments',q{});
my $decoded = decode_json($json); my $decoded = decode_j($json);
my @array=@{$decoded}; my @array=@{$decoded};
my %t; my %t;
for (@array) { $t{$_->{'name'}} = $_->{'id'} } for (@array) { $t{$_->{'name'}} = $_->{'id'} }
my @ids; my @ids;
for ( @rooms ) {push @ids, $t{$_}} for ( @rooms ) {push @ids, $t{$_}}
my %Hcmd = ( clean_segment => {segment_ids => \@ids,iterations => 1,customOrder => 'true' } ); my %Hcmd = ( clean_segment => {segment_ids => \@ids,iterations => 1,customOrder => 'true' } );
$ret = $devicetopic.'/MapSegmentationCapability/clean/set '.toJSON $Hcmd{$cmd} $ret = $devicetopic.'/MapSegmentationCapability/clean/set '.toJSON $Hcmd{$cmd}
} }
return $ret return $ret
} }
####### #######
# ask the robot via REST API for Featurelist and feature and return true false # ask the robot via REST API for Featurelist and feature and return true false
sub valetudo_f { sub valetudo_f {
my $NAME = shift; # Devicename of the robot my $NAME = shift; # Devicename of the robot
my $substr = shift; # requested Feature like GoToLocation or MapSegmentation my $substr = shift; # requested Feature like GoToLocation or MapSegmentation
my $ip=ReadingsVal($NAME,'ip4',(split ',',ReadingsVal($NAME,'ips','error'))[0]); my $ip = ReadingsVal($NAME,'ip4',(split ',',ReadingsVal($NAME,'ips','error'))[0]);
my $string = GetHttpFile($ip, '/api/v2/robot/capabilities'); my $string = GetHttpFile($ip, '/api/v2/robot/capabilities');
index($string, $substr) == -1 ? '0':'1'; index($string, $substr) == -1 ? '0':'1';
} }
####### #######
# add a line to multiline Attribute setList or regList # add a line to multiline Attribute setList or regList
# CommandAttr_multiline( 'MQTT2_valetudo_xxx','setList',q( clean_segment:{"multiple-strict,".valetudo_w($name,"segments")} { valetudo_c($NAME,$EVENT) }) ) # CommandAttr_multiline( 'MQTT2_valetudo_xxx','setList',q( clean_segment:{"multiple-strict,".valetudo_w($name,"segments")} { valetudo_c($NAME,$EVENT) }) )
sub CommandAttr_multiline { sub CommandAttr_multiline {
my $NAME = shift; my $NAME = shift;
my $attr = shift; my $attr = shift;
my $item = shift; my $item = shift;
if ($attr ne 'setList' and $attr ne 'readingList') {return 'use only for multiline attrib'} if ($attr ne 'setList' and $attr ne 'readingList') {return 'use only for multiline attrib'}
my $val = AttrVal($NAME,$attr,'')."\n".$item; my $val = AttrVal($NAME,$attr,'')."\n".$item;
CommandAttr(undef, "$NAME $attr $val"); CommandAttr(undef, "$NAME $attr $val");
}
################
# is never used, was in a first version used to preread the json in valetudo_c
# return simpel json pairs from presets format of valetudo
sub valetudo_r {
my $setter = shift;
my $payload = shift;
my $ret = 'error';
my %t;
if ($setter eq 'presets') {
my $decoded = decode_json($payload);
for (keys %$decoded) { $t{$decoded->{$_}->{'name'}} = $_ } # build a new hash only with names and ids pairs
$ret = toJSON(\%t); # result is sorted
}
return $ret
}
####### Aus dem Forum funktioniert aber nicht
# Zeigt aber wie man Readings zurück gibt
sub
valetudo2svg($$$)
{
my ($reading, $d, $filename) = @_;
my %ret;
if(!open FD,">$filename") {
$ret{$reading} = "ERROR: $filename: $!";
return \%ret;
}
print FD $d;
close(FD);
$ret{$reading} = "Wrote $filename";
return \%ret;
if($d !~ m/height":(\d+),"width":(\d+).*?floor":\[(.*\])\]/) {
$ret{$reading} = "ERROR: Unknown format";
return \%ret;
}
my ($w,$h,$nums) = ($1, $2, $3);
my $svg=<<"EOD";
<?xml version="1.0" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
<svg version="1.0" xmlns="http://www.w3.org/2000/svg" width="$w" height="$h" viewBox="0 0 $w $h">
<g fill="#000000" stroke="none">
<rect x="0" y="0" width="$w" height="$h" stroke="black" stroke-width="1" fill="none"/>
EOD
$nums =~ s/\[(\d+),(\d+)\]/
$svg .= "<rect x=\"$1\" y=\"$2\" width=\"1\" height=\"1\"\/>\n";
""
/xge;
$svg .= "</g></svg>";
if(!open FD,">$filename") {
$ret{$reading} = "ERROR: $filename: $!";
return \%ret;
}
print FD $svg;
close(FD);
$ret{$reading} = "Wrote $filename";
return \%ret;
} }
1; 1;