Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-04 22:19:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

50_SSChatBot.pm: update to version 1.10.6

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@22853 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
nasseeder1 2020-09-25 21:03:16 +00:00
parent 36b4d2f8d6
commit 26009a31a6
1 changed files with 151 additions and 215 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

366
fhem/FHEM/50_SSChatBot.pm
View File

@ -37,13 +37,18 @@ use strict;
use warnings; use warnings;
use GPUtils qw(GP_Import GP_Export); # wird für den Import der FHEM Funktionen aus der fhem.pl benötigt use GPUtils qw(GP_Import GP_Export); # wird für den Import der FHEM Funktionen aus der fhem.pl benötigt
my $vAPI; use FHEM::SynoModules::API qw(:all); # API Modul
my $vAPI = FHEM::SynoModules::API->VERSION();
use FHEM::SynoModules::SMUtils qw(jboolmap use FHEM::SynoModules::SMUtils qw(jboolmap
sortVersion sortVersion
setReadingErrorNone setReadingErrorNone
setReadingErrorState setReadingErrorState
listSendqueue
purgeSendqueue
updQueueLength
); );
my $vSMUtils = FHEM::SynoModules::SMUtils->VERSION(); # Hilfsroutinen Modul my $vSMUtils = FHEM::SynoModules::SMUtils->VERSION(); # Hilfsroutinen Modul
use FHEM::SynoModules::ErrCodes qw(:all); use FHEM::SynoModules::ErrCodes qw(:all);
my $vErrCodes = FHEM::SynoModules::ErrCodes->VERSION(); # Error Code Modul my $vErrCodes = FHEM::SynoModules::ErrCodes->VERSION(); # Error Code Modul
@ -118,6 +123,7 @@ BEGIN {
# Versions History intern # Versions History intern
my %vNotesIntern = ( my %vNotesIntern = (
"1.10.6" => "22.08.2020 use module FHEM::SynoModules::API ",
"1.10.5" => "25.09.2020 get error Codes from FHEM::SynoModules::ErrCodes, unify setVersionInfo, integrate FHEM::SynoModules::SMUtils ", "1.10.5" => "25.09.2020 get error Codes from FHEM::SynoModules::ErrCodes, unify setVersionInfo, integrate FHEM::SynoModules::SMUtils ",
"1.10.4" => "22.08.2020 minor code changes ", "1.10.4" => "22.08.2020 minor code changes ",
"1.10.3" => "20.08.2020 more code refactoring according PBP ", "1.10.3" => "20.08.2020 more code refactoring according PBP ",
@ -170,30 +176,30 @@ $hapi{INFO}{PATH} = "query.cgi";
$hapi{INFO}{VER} = 1; $hapi{INFO}{VER} = 1;
my %hset = ( # Hash für Set-Funktion my %hset = ( # Hash für Set-Funktion
botToken => { fn => "_setbotToken" }, botToken => { fn => \&_setbotToken },
listSendqueue => { fn => "_setlistSendqueue" }, listSendqueue => { fn => \&listSendqueue },
purgeSendqueue => { fn => "_setpurgeSendqueue" }, purgeSendqueue => { fn => \&purgeSendqueue },
asyncSendItem => { fn => "_setasyncSendItem" }, asyncSendItem => { fn => \&_setasyncSendItem },
restartSendqueue => { fn => "_setrestartSendqueue" }, restartSendqueue => { fn => \&_setrestartSendqueue },
); );
my %hget = ( # Hash für Get-Funktion my %hget = ( # Hash für Get-Funktion
storedToken => { fn => "_getstoredToken" }, storedToken => { fn => \&_getstoredToken },
chatUserlist => { fn => "_getchatUserlist" }, chatUserlist => { fn => \&_getchatUserlist },
chatChannellist => { fn => "_getchatChannellist" }, chatChannellist => { fn => \&_getchatChannellist },
versionNotes => { fn => "_getversionNotes" }, versionNotes => { fn => \&_getversionNotes },
); );
my %hmodep = ( # Hash für Opmode Parse my %hmodep = ( # Hash für Opmode Parse
chatUserlist => { fn => "_parseUsers" }, chatUserlist => { fn => \&_parseUsers },
chatChannellist => { fn => "_parseChannels" }, chatChannellist => { fn => \&_parseChannels },
sendItem => { fn => "_parseSendItem" }, sendItem => { fn => \&_parseSendItem },
); );
my %hrecbot = ( # Hash für botCGI receice Slash-commands (/set, /get, /code) my %hrecbot = ( # Hash für botCGI receice Slash-commands (/set, /get, /code)
set => { fn => "__botCGIrecSet" }, set => { fn => \&__botCGIrecSet },
get => { fn => "__botCGIrecGet" }, get => { fn => \&__botCGIrecGet },
cod => { fn => "__botCGIrecCod" }, cod => { fn => \&__botCGIrecCod },
); );
################################################################ ################################################################
@ -348,7 +354,8 @@ sub Attr {
if ($do == 1) { if ($do == 1) {
RemoveInternalTimer($hash); RemoveInternalTimer($hash);
} else { }
else {
InternalTimer(gettimeofday()+2, "FHEM::SSChatBot::initOnBoot", $hash, 0) if($init_done); InternalTimer(gettimeofday()+2, "FHEM::SSChatBot::initOnBoot", $hash, 0) if($init_done);
} }
@ -394,7 +401,8 @@ sub Set {
$setlist = "Unknown argument $opt, choose one of ". $setlist = "Unknown argument $opt, choose one of ".
"botToken " "botToken "
; ;
} else { }
else {
$setlist = "Unknown argument $opt, choose one of ". $setlist = "Unknown argument $opt, choose one of ".
"botToken ". "botToken ".
"listSendqueue:noArg ". "listSendqueue:noArg ".
@ -411,14 +419,12 @@ sub Set {
prop => $prop, prop => $prop,
aref => \@items, aref => \@items,
}; };
no strict "refs"; ## no critic 'NoStrict' if($hset{$opt} && defined &{$hset{$opt}{fn}}) {
if($hset{$opt}) { my $ret = q{};
my $ret = ""; $ret = &{$hset{$opt}{fn}} ($params);
$ret = &{$hset{$opt}{fn}} ($params) if(defined &{$hset{$opt}{fn}});
return $ret; return $ret;
} }
use strict "refs";
return $setlist; return $setlist;
} }
@ -426,7 +432,7 @@ return $setlist;
################################################################ ################################################################
# Setter botToken # Setter botToken
################################################################ ################################################################
sub _setbotToken { ## no critic "not used" sub _setbotToken {
my $paref = shift; my $paref = shift;
my $hash = $paref->{hash}; my $hash = $paref->{hash};
my $name = $paref->{name}; my $name = $paref->{name};
@ -439,72 +445,14 @@ sub _setbotToken { ## no critic "not used"
if($success) { if($success) {
CommandGet(undef, "$name chatUserlist"); # Chatuser Liste abrufen CommandGet(undef, "$name chatUserlist"); # Chatuser Liste abrufen
return qq{botToken saved successfully}; return qq{botToken saved successfully};
} else { }
else {
return qq{Error while saving botToken - see logfile for details}; return qq{Error while saving botToken - see logfile for details};
} }
return; return;
} }
################################################################
# Setter listSendqueue
################################################################
sub _setlistSendqueue { ## no critic "not used"
my $paref = shift;
my $name = $paref->{name};
my $sub = sub {
my $idx = shift;
my $ret;
for my $key (reverse sort keys %{$data{SSChatBot}{$name}{sendqueue}{entries}{$idx}}) {
$ret .= ", " if($ret);
$ret .= $key."=>".$data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{$key};
}
return $ret;
};
if (!keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
return qq{SendQueue is empty.};
}
my $sq;
for my $idx (sort{$a<=>$b} keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
$sq .= $idx." => ".$sub->($idx)."\n";
}
return $sq;
}
################################################################
# Setter purgeSendqueue
################################################################
sub _setpurgeSendqueue { ## no critic "not used"
my $paref = shift;
my $hash = $paref->{hash};
my $name = $paref->{name};
my $prop = $paref->{prop};
if($prop eq "-all-") {
delete $hash->{OPIDX};
delete $data{SSChatBot}{$name}{sendqueue}{entries};
$data{SSChatBot}{$name}{sendqueue}{index} = 0;
return "All entries of SendQueue are deleted";
} elsif($prop eq "-permError-") {
for my $idx (keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
delete $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}
if($data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{forbidSend});
}
return qq{All entries with state "permanent send error" are deleted};
} else {
delete $data{SSChatBot}{$name}{sendqueue}{entries}{$prop};
return qq{SendQueue entry with index "$prop" deleted};
}
return;
}
###################################################################################################### ######################################################################################################
# Setter asyncSendItem # Setter asyncSendItem
# #
@ -516,7 +464,7 @@ return;
# text="aktuelles SVG-Plot" svg="<SVG-Device>,<zoom>,<offset>" users="user1,user2" # text="aktuelles SVG-Plot" svg="<SVG-Device>,<zoom>,<offset>" users="user1,user2"
# #
###################################################################################################### ######################################################################################################
sub _setasyncSendItem { ## no critic "not used" sub _setasyncSendItem {
my $paref = shift; my $paref = shift;
my $hash = $paref->{hash}; my $hash = $paref->{hash};
my $name = $paref->{name}; my $name = $paref->{name};
@ -585,7 +533,7 @@ sub _setasyncSendItem { #
channel => "", channel => "",
attachment => $attachment attachment => $attachment
}; };
addQueue ($params); addSendqueue ($params);
} }
getApiSites($name); getApiSites($name);
@ -596,7 +544,7 @@ return;
################################################################ ################################################################
# Setter restartSendqueue # Setter restartSendqueue
################################################################ ################################################################
sub _setrestartSendqueue { ## no critic "not used" sub _setrestartSendqueue {
my $paref = shift; my $paref = shift;
my $hash = $paref->{hash}; my $hash = $paref->{hash};
my $name = $paref->{name}; my $name = $paref->{name};
@ -604,7 +552,8 @@ sub _setrestartSendqueue { ## no critic "not used"
if($prop && $prop eq "force") { if($prop && $prop eq "force") {
$hash->{HELPER}{RESENDFORCE} = 1; $hash->{HELPER}{RESENDFORCE} = 1;
} else { }
else {
delete $hash->{HELPER}{RESENDFORCE}; delete $hash->{HELPER}{RESENDFORCE};
} }
@ -627,9 +576,9 @@ sub Get {
my $getlist; my $getlist;
if(!$hash->{TOKEN}) { if(!$hash->{TOKEN}) {
return; return;
}
} else { else {
$getlist = "Unknown argument $opt, choose one of ". $getlist = "Unknown argument $opt, choose one of ".
"storedToken:noArg ". "storedToken:noArg ".
"chatUserlist:noArg ". "chatUserlist:noArg ".
@ -646,14 +595,12 @@ sub Get {
opt => $opt, opt => $opt,
arg => $arg, arg => $arg,
}; };
no strict "refs"; ## no critic 'NoStrict' if($hget{$opt} && defined &{$hget{$opt}{fn}}) {
if($hget{$opt}) { my $ret = q{};
my $ret = ""; $ret = &{$hget{$opt}{fn}} ($pars);
$ret = &{$hget{$opt}{fn}} ($pars) if(defined &{$hget{$opt}{fn}});
return $ret; return $ret;
} }
use strict "refs";
return $getlist; # not generate trigger out of command return $getlist; # not generate trigger out of command
} }
@ -661,7 +608,7 @@ return $getlist; # not ge
################################################################ ################################################################
# Getter storedToken # Getter storedToken
################################################################ ################################################################
sub _getstoredToken { ## no critic "not used" sub _getstoredToken {
my $paref = shift; my $paref = shift;
my $hash = $paref->{hash}; my $hash = $paref->{hash};
my $name = $paref->{name}; my $name = $paref->{name};
@ -680,7 +627,7 @@ sub _getstoredToken { ## no critic "not used"
################################################################ ################################################################
# Getter chatUserlist # Getter chatUserlist
################################################################ ################################################################
sub _getchatUserlist { ## no critic "not used" sub _getchatUserlist {
my $paref = shift; my $paref = shift;
my $hash = $paref->{hash}; my $hash = $paref->{hash};
my $name = $paref->{name}; my $name = $paref->{name};
@ -700,7 +647,7 @@ sub _getchatUserlist { ## no critic "not used"
channel => "", channel => "",
attachment => "" attachment => ""
}; };
addQueue ($params); addSendqueue($params);
getApiSites ($name); getApiSites ($name);
return; return;
@ -709,7 +656,7 @@ return;
################################################################ ################################################################
# Getter chatChannellist # Getter chatChannellist
################################################################ ################################################################
sub _getchatChannellist { ## no critic "not used" sub _getchatChannellist {
my $paref = shift; my $paref = shift;
my $hash = $paref->{hash}; my $hash = $paref->{hash};
my $name = $paref->{name}; my $name = $paref->{name};
@ -729,7 +676,7 @@ sub _getchatChannellist { ## no critic "not used"
channel => "", channel => "",
attachment => "" attachment => ""
}; };
addQueue ($params); addSendqueue($params);
getApiSites ($name); getApiSites ($name);
return; return;
@ -738,7 +685,7 @@ return;
################################################################ ################################################################
# Getter versionNotes # Getter versionNotes
################################################################ ################################################################
sub _getversionNotes { ## no critic "not used" sub _getversionNotes {
my $paref = shift; my $paref = shift;
my $arg = $paref->{arg}; my $arg = $paref->{arg};
@ -764,14 +711,17 @@ sub _getversionNotes { ## no critic "not used"
for my $hint (@hints) { for my $hint (@hints) {
if(AttrVal("global","language","EN") eq "DE") { if(AttrVal("global","language","EN") eq "DE") {
$hs{$hint} = $vHintsExt_de{$hint}; $hs{$hint} = $vHintsExt_de{$hint};
} else { }
else {
$hs{$hint} = $vHintsExt_en{$hint}; $hs{$hint} = $vHintsExt_en{$hint};
} }
} }
} else { }
else {
if(AttrVal("global","language","EN") eq "DE") { if(AttrVal("global","language","EN") eq "DE") {
%hs = %vHintsExt_de; %hs = %vHintsExt_de;
} else { }
else {
%hs = %vHintsExt_en; %hs = %vHintsExt_en;
} }
} }
@ -781,10 +731,11 @@ sub _getversionNotes { ## no critic "not used"
$ret .= sprintf("<td style=\"vertical-align:top\"><b>$key</b> </td><td style=\"vertical-align:top\">$val0</td>" ); $ret .= sprintf("<td style=\"vertical-align:top\"><b>$key</b> </td><td style=\"vertical-align:top\">$val0</td>" );
$ret .= "</tr>"; $ret .= "</tr>";
$i++; $i++;
if ($i & 1) {
# $i ist ungerade if ($i & 1) { # $i ist ungerade
$ret .= "<tr class=\"odd\">"; $ret .= "<tr class=\"odd\">";
} else { }
else {
$ret .= "<tr class=\"even\">"; $ret .= "<tr class=\"even\">";
} }
} }
@ -806,10 +757,11 @@ sub _getversionNotes { ## no critic "not used"
$ret .= sprintf("<td style=\"vertical-align:top\"><b>$key</b> </td><td style=\"vertical-align:top\">$val0 </td><td>$val1</td>" ); $ret .= sprintf("<td style=\"vertical-align:top\"><b>$key</b> </td><td style=\"vertical-align:top\">$val0 </td><td>$val1</td>" );
$ret .= "</tr>"; $ret .= "</tr>";
$i++; $i++;
if ($i & 1) {
# $i ist ungerade if ($i & 1) { # $i ist ungerade
$ret .= "<tr class=\"odd\">"; $ret .= "<tr class=\"odd\">";
} else { }
else {
$ret .= "<tr class=\"even\">"; $ret .= "<tr class=\"even\">";
} }
} }
@ -834,8 +786,7 @@ sub initOnBoot {
RemoveInternalTimer($hash, "FHEM::SSChatBot::initOnBoot"); RemoveInternalTimer($hash, "FHEM::SSChatBot::initOnBoot");
if ($init_done) { if ($init_done) { # check ob FHEMWEB Instanz für SSChatBot angelegt ist -> sonst anlegen
# check ob FHEMWEB Instanz für SSChatBot angelegt ist -> sonst anlegen
my @FWports; my @FWports;
my $FWname = "sschat"; # der Pfad nach http://hostname:port/ der neuen FHEMWEB Instanz -> http://hostname:port/sschat my $FWname = "sschat"; # der Pfad nach http://hostname:port/ der neuen FHEMWEB Instanz -> http://hostname:port/sschat
my $FW = "WEBSSChatBot"; # Name der FHEMWEB Instanz für SSChatBot my $FW = "WEBSSChatBot"; # Name der FHEMWEB Instanz für SSChatBot
@ -870,9 +821,9 @@ sub initOnBoot {
CommandAttr(undef, "$FW room $room"); CommandAttr(undef, "$FW room $room");
CommandAttr(undef, "$FW csrfToken $csrf"); CommandAttr(undef, "$FW csrfToken $csrf");
CommandAttr(undef, "$FW comment WEB Instance for SSChatBot devices.\nIt catches outgoing messages from Synology Chat server.\nDon't edit this device manually (except such attributes like \"room\", \"icon\") !"); CommandAttr(undef, "$FW comment WEB Instance for SSChatBot devices.\nIt catches outgoing messages from Synology Chat server.\nDon't edit this device manually (except such attributes like \"room\", \"icon\") !");
CommandAttr(undef, "$FW stylesheetPrefix default"); CommandAttr(undef, "$FW stylesheetPrefix default");
}
} else { else {
Log3($name, 2, "$name - ERROR while creating FHEMWEB instance ".$hash->{FW}." with webname \"$FWname\" !"); Log3($name, 2, "$name - ERROR while creating FHEMWEB instance ".$hash->{FW}." with webname \"$FWname\" !");
readingsBeginUpdate($hash); readingsBeginUpdate($hash);
readingsBulkUpdate ($hash, "state", "ERROR in initialization - see logfile"); readingsBulkUpdate ($hash, "state", "ERROR in initialization - see logfile");
@ -897,9 +848,9 @@ sub initOnBoot {
addExtension($name, "FHEM::SSChatBot::botCGI", "outchat"); addExtension($name, "FHEM::SSChatBot::botCGI", "outchat");
$hash->{HELPER}{INFIX} = "outchat"; $hash->{HELPER}{INFIX} = "outchat";
} }
}
} else { else {
InternalTimer(gettimeofday()+3, "FHEM::SSChatBot::initOnBoot", $hash, 0); InternalTimer(gettimeofday()+3, "FHEM::SSChatBot::initOnBoot", $hash, 0);
} }
@ -911,7 +862,7 @@ return;
# #
# ($name,$opmode,$method,$userid,$text,$fileUrl,$channel,$attachment) # ($name,$opmode,$method,$userid,$text,$fileUrl,$channel,$attachment)
###################################################################################### ######################################################################################
sub addQueue { sub addSendqueue {
my $paref = shift; my $paref = shift;
my $name = $paref->{name} // do {my $err = qq{internal ERROR -> name is empty}; Log 1, "SSChatBot - $err"; return}; my $name = $paref->{name} // do {my $err = qq{internal ERROR -> name is empty}; Log 1, "SSChatBot - $err"; return};
my $hash = $defs{$name}; my $hash = $defs{$name};
@ -949,7 +900,7 @@ sub addQueue {
$data{SSChatBot}{$name}{sendqueue}{entries}{$index} = $pars; $data{SSChatBot}{$name}{sendqueue}{entries}{$index} = $pars;
updQLength ($hash); # updaten Länge der Sendequeue updQueueLength ($hash); # update Länge der Sendequeue
return; return;
} }
@ -985,7 +936,7 @@ sub checkRetry {
if(!keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) { if(!keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
Log3($name, 4, "$name - SendQueue is empty. Nothing to do ..."); Log3($name, 4, "$name - SendQueue is empty. Nothing to do ...");
updQLength ($hash); updQueueLength ($hash);
return; return;
} }
@ -993,10 +944,10 @@ sub checkRetry {
delete $hash->{OPIDX}; delete $hash->{OPIDX};
delete $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}; delete $data{SSChatBot}{$name}{sendqueue}{entries}{$idx};
Log3($name, 4, qq{$name - Opmode "$hash->{OPMODE}" finished successfully, Sendqueue index "$idx" deleted.}); Log3($name, 4, qq{$name - Opmode "$hash->{OPMODE}" finished successfully, Sendqueue index "$idx" deleted.});
updQLength ($hash); updQueueLength ($hash);
return getApiSites($name); # nächsten Eintrag abarbeiten (wenn SendQueue nicht leer) return getApiSites($name); # nächsten Eintrag abarbeiten (wenn SendQueue nicht leer)
}
} else { # Befehl nicht erfolgreich, (verzögertes) Senden einplanen else { # Befehl nicht erfolgreich, (verzögertes) Senden einplanen
$data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{retryCount}++; $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{retryCount}++;
my $rc = $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{retryCount}; my $rc = $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{retryCount};
@ -1010,7 +961,7 @@ sub checkRetry {
delete $hash->{OPIDX}; delete $hash->{OPIDX};
delete $hash->{OPMODE}; delete $hash->{OPMODE};
updQLength ($hash); # updaten Länge der Sendequeue updQueueLength ($hash); # updaten Länge der Sendequeue
return getApiSites($name); # nächsten Eintrag abarbeiten (wenn SendQueue nicht leer); return getApiSites($name); # nächsten Eintrag abarbeiten (wenn SendQueue nicht leer);
} }
@ -1028,8 +979,8 @@ sub checkRetry {
Log3($name, 2, "$name - ERROR - \"$hash->{OPMODE}\" SendQueue index \"$idx\" not executed. Restart SendQueue in $rs seconds (retryCount $rc)."); Log3($name, 2, "$name - ERROR - \"$hash->{OPMODE}\" SendQueue index \"$idx\" not executed. Restart SendQueue in $rs seconds (retryCount $rc).");
my $rst = gettimeofday()+$rs; # resend Timer my $rst = gettimeofday()+$rs; # resend Timer
updQLength ($hash,$rst); # updaten Länge der Sendequeue mit resend Timer updQueueLength ($hash,$rst); # updaten Länge der Sendequeue mit resend Timer
startQueue ($name,$rst); startQueue ($name,$rst);
} }
} }
@ -1076,20 +1027,32 @@ sub getApiSites {
return $ret; return $ret;
} }
if ($hash->{HELPER}{API}{PARSET}) { # API-Hashwerte sind bereits gesetzt -> Abruf überspringen if ($hash->{HELPER}{API}{PARSET}) { # API-Hashwerte sind bereits gesetzt -> Abruf überspringen
Log3($name, 4, "$name - API hashvalues already set - ignore get apisites"); Log3($name, 4, "$name - API hashvalues already set - ignore get apisites");
return chatOp($name); return chatOp($name);
} }
my $httptimeout = AttrVal($name,"httptimeout",20); my $httptimeout = AttrVal($name,"httptimeout",20);
Log3($name, 5, "$name - HTTP-Call will be done with httptimeout: $httptimeout s"); Log3($name, 5, "$name - HTTP-Call will be done with httptimeout: $httptimeout s");
# API initialisieren und abrufen
####################################
$hash->{HELPER}{API} = apistatic ("chat"); # API Template im HELPER instanziieren
Log3 ($name, 4, "$name - API imported:\n".Dumper $hash->{HELPER}{API});
my @ak;
for my $key (keys %{$hash->{HELPER}{API}}) {
next if($key =~ /^(?: PARSET | INFO)$/x);
push @ak, $hash->{HELPER}{API}{$key}{NAME};
}
my $apis = join ",", @ak;
# URL zur Abfrage der Eigenschaften der API's
$url = "$inprot://$inaddr:$inport/webapi/$hash->{HELPER}{API}{INFO}{PATH}?". $url = "$inprot://$inaddr:$inport/webapi/$hash->{HELPER}{API}{INFO}{PATH}?".
"api=$hash->{HELPER}{API}{INFO}{NAME}". "api=$hash->{HELPER}{API}{INFO}{NAME}".
"&method=Query". "&method=Query".
"&version=$hash->{HELPER}{API}{INFO}{VER}". "&version=$hash->{HELPER}{API}{INFO}{VER}".
"&query=$hash->{HELPER}{API}{EXTERNAL}{NAME}"; "&query=$apis";
Log3($name, 4, "$name - Call-Out: $url"); Log3($name, 4, "$name - Call-Out: $url");
@ -1114,10 +1077,12 @@ sub getApiSites_parse {
my $param = shift; my $param = shift;
my $err = shift; my $err = shift;
my $myjson = shift; my $myjson = shift;
my $hash = $param->{hash}; my $hash = $param->{hash};
my $name = $hash->{NAME}; my $name = $hash->{NAME};
my $inaddr = $hash->{INADDR}; my $inaddr = $hash->{INADDR};
my $inport = $hash->{INPORT}; my $inport = $hash->{INPORT};
my $external = $hash->{HELPER}{API}{EXTERNAL}{NAME}; my $external = $hash->{HELPER}{API}{EXTERNAL}{NAME};
my ($error,$errorcode,$success); my ($error,$errorcode,$success);
@ -1147,40 +1112,33 @@ sub getApiSites_parse {
$success = $data->{'success'}; $success = $data->{'success'};
if ($success) { if ($success) {
my ($logp,$logv);
my $pundef = "Path: undefined - Surveillance Station may be stopped";
my $vundef = "Version: undefined - Surveillance Station may be stopped";
# Pfad und Maxversion von "SYNO.Chat.External" ermitteln # Pfad und Maxversion von "SYNO.Chat.External" ermitteln
my $externalpath = $data->{'data'}->{$external}->{'path'}; my $externalpath = $data->{'data'}->{$external}->{'path'};
$externalpath =~ tr/_//d if (defined($externalpath)); $externalpath =~ tr/_//d if (defined($externalpath));
my $externalver = $data->{'data'}->{$external}->{'maxVersion'}; my $externalver = $data->{'data'}->{$external}->{'maxVersion'};
$logp = defined($externalpath) ? "Path: $externalpath" : $pundef;
$logv = defined($externalver) ? "Version: $externalver" : $vundef;
Log3($name, 4, "$name - API $external -> $logp, $logv");
# ermittelte Werte in $hash einfügen # ermittelte Werte in $hash einfügen
if(defined($externalpath) && defined($externalver)) { if(defined($externalpath) && defined($externalver)) {
$hash->{HELPER}{API}{EXTERNAL}{PATH} = $externalpath; $hash->{HELPER}{API}{EXTERNAL}{PATH} = $externalpath;
$hash->{HELPER}{API}{EXTERNAL}{VER} = $externalver; $hash->{HELPER}{API}{EXTERNAL}{VER} = $externalver;
$hash->{HELPER}{API}{PARSET} = 1; # Webhook Hash values sind gesetzt $hash->{HELPER}{API}{PARSET} = 1; # API Hash values sind gesetzt
Log3 ($name, 4, "$name - API completed after retrieval and adaption:\n".Dumper $hash->{HELPER}{API});
setReadingErrorNone($hash, 1); setReadingErrorNone($hash, 1);
}
} else { else {
$errorcode = "805"; $errorcode = "805";
$error = expErrors($hash,$errorcode); # Fehlertext zum Errorcode ermitteln $error = expErrors($hash,$errorcode); # Fehlertext zum Errorcode ermitteln
setReadingErrorState ($hash, $error, $errorcode); setReadingErrorState ($hash, $error, $errorcode);
checkRetry ($name,1); checkRetry ($name,1);
return; return;
} }
}
} else { else {
$errorcode = "806"; $errorcode = "806";
$error = expErrors($hash,$errorcode); # Fehlertext zum Errorcode ermitteln $error = expErrors($hash,$errorcode); # Fehlertext zum Errorcode ermitteln
@ -1256,10 +1214,11 @@ sub chatOp {
} }
my $part = $url; my $part = $url;
if(AttrVal($name, "showTokenInLog", "0") == 1) { if(AttrVal($name, "showTokenInLog", "0") == 1) {
Log3($name, 4, "$name - Call-Out: $url"); Log3($name, 4, "$name - Call-Out: $url");
}
} else { else {
$part =~ s/$token/<secret>/x; $part =~ s/$token/<secret>/x;
Log3($name, 4, "$name - Call-Out: $part"); Log3($name, 4, "$name - Call-Out: $part");
} }
@ -1323,11 +1282,9 @@ sub chatOp_parse {
if ($success) { if ($success) {
no strict "refs"; ## no critic 'NoStrict'
if($hmodep{$opmode} && defined &{$hmodep{$opmode}{fn}}) { if($hmodep{$opmode} && defined &{$hmodep{$opmode}{fn}}) {
&{$hmodep{$opmode}{fn}} ($hash, $data); &{$hmodep{$opmode}{fn}} ($hash, $data);
} }
use strict "refs";
checkRetry ($name,0); checkRetry ($name,0);
@ -1335,9 +1292,9 @@ sub chatOp_parse {
readingsBulkUpdateIfChanged ($hash, "Errorcode", "none" ); readingsBulkUpdateIfChanged ($hash, "Errorcode", "none" );
readingsBulkUpdateIfChanged ($hash, "Error", "none" ); readingsBulkUpdateIfChanged ($hash, "Error", "none" );
readingsBulkUpdate ($hash, "state", "active"); readingsBulkUpdate ($hash, "state", "active");
readingsEndUpdate ($hash,1); readingsEndUpdate ($hash,1);
}
} else { else {
# die API-Operation war fehlerhaft # die API-Operation war fehlerhaft
# Errorcode aus JSON ermitteln # Errorcode aus JSON ermitteln
$errorcode = $data->{'error'}->{'code'}; $errorcode = $data->{'error'}->{'code'};
@ -1363,7 +1320,7 @@ return;
################################################################ ################################################################
# parse Opmode chatUserlist # parse Opmode chatUserlist
################################################################ ################################################################
sub _parseUsers { ## no critic "not used" sub _parseUsers {
my $hash = shift; my $hash = shift;
my $data = shift; my $data = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -1431,7 +1388,7 @@ return;
################################################################ ################################################################
# parse Opmode chatChannellist # parse Opmode chatChannellist
################################################################ ################################################################
sub _parseChannels { ## no critic "not used" sub _parseChannels {
my $hash = shift; my $hash = shift;
my $data = shift; my $data = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -1479,7 +1436,7 @@ return;
################################################################ ################################################################
# parse Opmode sendItem # parse Opmode sendItem
################################################################ ################################################################
sub _parseSendItem { ## no critic "not used" sub _parseSendItem {
my $hash = shift; my $hash = shift;
my $data = shift; my $data = shift;
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@ -1544,7 +1501,8 @@ sub setToken {
if ($retcode) { if ($retcode) {
Log3($name, 2, "$name - Error while saving Token - $retcode"); Log3($name, 2, "$name - Error while saving Token - $retcode");
$success = 0; $success = 0;
} else { }
else {
($success, $token) = getToken($hash,1,$ao); # Credentials nach Speicherung lesen und in RAM laden ($boot=1) ($success, $token) = getToken($hash,1,$ao); # Credentials nach Speicherung lesen und in RAM laden ($boot=1)
} }
@ -1578,8 +1536,8 @@ sub getToken {
$hash->{TOKEN} = "Set"; $hash->{TOKEN} = "Set";
$success = 1; $success = 1;
} }
}
} else { else {
# boot = 0 -> botToken aus RAM lesen, decoden und zurückgeben # boot = 0 -> botToken aus RAM lesen, decoden und zurückgeben
$credstr = $hash->{HELPER}{TOKEN}; $credstr = $hash->{HELPER}{TOKEN};
@ -1596,8 +1554,8 @@ sub getToken {
my $logtok = AttrVal($name, "showTokenInLog", "0") == 1 ? $token : "********"; my $logtok = AttrVal($name, "showTokenInLog", "0") == 1 ? $token : "********";
Log3($name, 4, "$name - botToken read from RAM: $logtok"); Log3($name, 4, "$name - botToken read from RAM: $logtok");
}
} else { else {
Log3($name, 2, "$name - botToken not set in RAM !"); Log3($name, 2, "$name - botToken not set in RAM !");
} }
@ -1646,29 +1604,6 @@ sub removeExtension {
return; return;
} }
#############################################################################################
# Länge Senedequeue updaten
#############################################################################################
sub updQLength {
my ($hash,$rst) = @_;
my $name = $hash->{NAME};
my $ql = keys %{$data{SSChatBot}{$name}{sendqueue}{entries}};
readingsBeginUpdate ($hash);
readingsBulkUpdateIfChanged ($hash, "QueueLenth", $ql); # Länge Sendqueue updaten
readingsEndUpdate ($hash,1);
my $head = "next planned SendQueue start:";
if($rst) { # resend Timer gesetzt
$hash->{RESEND} = $head." ".FmtDateTime($rst);
} else {
$hash->{RESEND} = $head." immediately by next entry";
}
return;
}
############################################################################################# #############################################################################################
# Text für den Versand an Synology Chat formatieren # Text für den Versand an Synology Chat formatieren
# und nicht erlaubte Zeichen entfernen # und nicht erlaubte Zeichen entfernen
@ -1690,8 +1625,8 @@ sub formString {
"%" => "%25", # % ist nicht erlaubt und wird encodiert "%" => "%25", # % ist nicht erlaubt und wird encodiert
"+" => "%2B", "+" => "%2B",
); );
}
} else { else {
%replacements = ( %replacements = (
" H" => "%20H" # Bug in HttpUtils(?) wenn vor großem H ein Zeichen + Leerzeichen vorangeht " H" => "%20H" # Bug in HttpUtils(?) wenn vor großem H ein Zeichen + Leerzeichen vorangeht
); );
@ -1730,8 +1665,7 @@ sub getClhash {
return; return;
} }
if (!defined($hash->{CL})) { if (!defined($hash->{CL})) { # Clienthash wurde nicht übergeben und wird erstellt (FHEMWEB Instanzen mit canAsyncOutput=1 analysiert)
# Clienthash wurde nicht übergeben und wird erstellt (FHEMWEB Instanzen mit canAsyncOutput=1 analysiert)
my @webdvs = devspec2array("TYPE=FHEMWEB:FILTER=canAsyncOutput=1:FILTER=STATE=Connected"); my @webdvs = devspec2array("TYPE=FHEMWEB:FILTER=canAsyncOutput=1:FILTER=STATE=Connected");
my $i = 1; my $i = 1;
for my $outdev (@webdvs) { for my $outdev (@webdvs) {
@ -1741,8 +1675,8 @@ sub getClhash {
$hash->{HELPER}{CL}{$i}->{COMP} = 1; $hash->{HELPER}{CL}{$i}->{COMP} = 1;
$i++; $i++;
} }
} else { }
# übergebenen CL-Hash in Helper eintragen else { # übergebenen CL-Hash in Helper eintragen
$hash->{HELPER}{CL}{1} = $hash->{CL}; $hash->{HELPER}{CL}{1} = $hash->{CL};
} }
@ -1755,7 +1689,8 @@ sub getClhash {
Log3($name, 4, "$name - Clienthash: $key -> $val"); Log3($name, 4, "$name - Clienthash: $key -> $val");
} }
} }
} else { }
else {
Log3($name, 2, "$name - Clienthash was neither delivered nor created !"); Log3($name, 2, "$name - Clienthash was neither delivered nor created !");
$ret = "Clienthash was neither delivered nor created. Can't use asynchronous output for function."; $ret = "Clienthash was neither delivered nor created. Can't use asynchronous output for function.";
} }
@ -2031,8 +1966,8 @@ sub __botCGIcheckToken {
channel => "", channel => "",
attachment => "" attachment => ""
}; };
addQueue ($params); addSendqueue($params);
startQueue ($name, $rst); startQueue ($name, $rst);
return ("text/plain; charset=utf-8", "400 Bad Request"); return ("text/plain; charset=utf-8", "400 Bad Request");
} }
@ -2117,10 +2052,8 @@ sub __botCGIdataInterprete {
}; };
if($hrecbot{$p1} && defined &{$hrecbot{$p1}{fn}}) { if($hrecbot{$p1} && defined &{$hrecbot{$p1}{fn}}) {
$do = 1; $do = 1;
no strict "refs"; ## no critic 'NoStrict' ($command, $cr, $state) = &{$hrecbot{$p1}{fn}} ($pars);
($command, $cr, $state) = &{$hrecbot{$p1}{fn}} ($pars);
use strict "refs";
} }
$cr = $cr ne q{} ? $cr : qq{command '$command' executed}; $cr = $cr ne q{} ? $cr : qq{command '$command' executed};
@ -2138,7 +2071,7 @@ sub __botCGIdataInterprete {
channel => "", channel => "",
attachment => "" attachment => ""
}; };
addQueue ($params); addSendqueue ($params);
} }
my $ua = $attr{$name}{userattr}; # Liste aller ownCommandxx zusammenstellen my $ua = $attr{$name}{userattr}; # Liste aller ownCommandxx zusammenstellen
@ -2180,7 +2113,7 @@ sub __botCGIdataInterprete {
channel => "", channel => "",
attachment => "" attachment => ""
}; };
addQueue ($params); addSendqueue ($params);
} }
} }
@ -2195,7 +2128,7 @@ return ($command, $cr, $text);
# botCGI /set # botCGI /set
# set-Befehl in FHEM ausführen # set-Befehl in FHEM ausführen
################################################################ ################################################################
sub __botCGIrecSet { ## no critic "not used" sub __botCGIrecSet {
my $paref = shift; my $paref = shift;
my $name = $paref->{name}; my $name = $paref->{name};
my $username = $paref->{username}; my $username = $paref->{username};
@ -2219,7 +2152,7 @@ return ($command, $cr, $state);
# botCGI /get # botCGI /get
# get-Befehl in FHEM ausführen # get-Befehl in FHEM ausführen
################################################################ ################################################################
sub __botCGIrecGet { ## no critic "not used" sub __botCGIrecGet {
my $paref = shift; my $paref = shift;
my $name = $paref->{name}; my $name = $paref->{name};
my $username = $paref->{username}; my $username = $paref->{username};
@ -2243,7 +2176,7 @@ return ($command, $cr, $state);
# botCGI /code # botCGI /code
# Perl Code in FHEM ausführen # Perl Code in FHEM ausführen
################################################################ ################################################################
sub __botCGIrecCod { ## no critic "not used" sub __botCGIrecCod {
my $paref = shift; my $paref = shift;
my $name = $paref->{name}; my $name = $paref->{name};
my $username = $paref->{username}; my $username = $paref->{username};
@ -2323,7 +2256,8 @@ sub ___botCGIorder {
if($arg) { if($arg) {
Log3($name, 4, qq{$name - Synology Chat user "$username" execute FHEM command: }.$arg); Log3($name, 4, qq{$name - Synology Chat user "$username" execute FHEM command: }.$arg);
$cr = AnalyzePerlCommand(undef, $arg); $cr = AnalyzePerlCommand(undef, $arg);
} else { }
else {
$cr = qq{function format error: may be you didn't use the format {...}}; $cr = qq{function format error: may be you didn't use the format {...}};
} }
} }
@ -2333,7 +2267,8 @@ sub ___botCGIorder {
$cr = AnalyzeCommandChain(undef, $cmd); $cr = AnalyzeCommandChain(undef, $cmd);
} }
} else { }
else {
$cr = qq{User "$username" is not allowed execute "$cmd" command}; $cr = qq{User "$username" is not allowed execute "$cmd" command};
$state = qq{command execution denied}; $state = qq{command execution denied};
Log3($name, 2, qq{$name - WARNING - Chat user "$username" is not authorized for "$cmd" command. Execution denied !}); Log3($name, 2, qq{$name - WARNING - Chat user "$username" is not authorized for "$cmd" command. Execution denied !});
@ -2364,7 +2299,8 @@ sub setVersionInfo {
if($modules{$type}{META}{x_version}) { # {x_version} ( nur gesetzt wenn $Id$ im Kopf komplett! vorhanden ) if($modules{$type}{META}{x_version}) { # {x_version} ( nur gesetzt wenn $Id$ im Kopf komplett! vorhanden )
$modules{$type}{META}{x_version} =~ s/1\.1\.1/$v/gx; $modules{$type}{META}{x_version} =~ s/1\.1\.1/$v/gx;
} else { }
else {
$modules{$type}{META}{x_version} = $v; $modules{$type}{META}{x_version} = $v;
} }
return $@ unless (FHEM::Meta::SetInternals($hash)); # FVERSION wird gesetzt ( nur gesetzt wenn $Id$ im Kopf komplett! vorhanden ) return $@ unless (FHEM::Meta::SetInternals($hash)); # FVERSION wird gesetzt ( nur gesetzt wenn $Id$ im Kopf komplett! vorhanden )
@ -2372,8 +2308,8 @@ sub setVersionInfo {
if(__PACKAGE__ eq "FHEM::$type" || __PACKAGE__ eq $type) { # es wird mit Packages gearbeitet -> mit {<Modul>->VERSION()} im FHEMWEB kann Modulversion abgefragt werden if(__PACKAGE__ eq "FHEM::$type" || __PACKAGE__ eq $type) { # es wird mit Packages gearbeitet -> mit {<Modul>->VERSION()} im FHEMWEB kann Modulversion abgefragt werden
use version 0.77; our $VERSION = FHEM::Meta::Get($hash, 'version'); ## no critic 'VERSION' use version 0.77; our $VERSION = FHEM::Meta::Get($hash, 'version'); ## no critic 'VERSION'
} }
}
} else { # herkömmliche Modulstruktur else { # herkömmliche Modulstruktur
$hash->{VERSION} = $v; $hash->{VERSION} = $v;
} }