mhop/fhem
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

50_SSChatBot: contrib 1.6.1

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk@22007 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
DS_Starter
2020-05-22 17:42:15 +00:00
parent 429950db3c
commit cf93b643a0
1 changed files with 276 additions and 258 deletions
Download Patch File Download Diff File Expand all files Collapse all files

120
fhem/contrib/DS_Starter/50_SSChatBot.pm
View File

@@ -35,20 +35,21 @@ package main;
use strict; use strict;
use warnings; use warnings;
eval "use JSON;1;" or my $SSChatBotMM = "JSON"; # Debian: apt-get install libjson-perl eval "use JSON;1;" or my $SSChatBotMM = "JSON"; ## no critic 'eval' # Debian: apt-get install libjson-perl
use Data::Dumper; # Perl Core module use Data::Dumper; # Perl Core module
use MIME::Base64; use MIME::Base64;
use Time::HiRes; use Time::HiRes;
use HttpUtils; use HttpUtils;
use Encode; use Encode;
no if $] >= 5.017011, warnings => 'experimental::smartmatch'; no if $] >= 5.017011, warnings => 'experimental::smartmatch';
eval "use FHEM::Meta;1" or my $modMetaAbsent = 1; eval "use FHEM::Meta;1" or my $modMetaAbsent = 1; ## no critic 'eval'
eval "use Net::Domain qw(hostname hostfqdn hostdomain domainname);1" or my $SSChatBotNDom = "Net::Domain"; eval "use Net::Domain qw(hostname hostfqdn hostdomain domainname);1" or my $SSChatBotNDom = "Net::Domain"; ## no critic 'eval'
# no if $] >= 5.017011, warnings => 'experimental'; # no if $] >= 5.017011, warnings => 'experimental';
# Versions History intern # Versions History intern
our %SSChatBot_vNotesIntern = ( my %SSChatBot_vNotesIntern = (
"1.6.1" => "22.05.2020 changes according to PBP ",
"1.6.0" => "22.05.2020 replace \" H\" with \"%20H\" in attachments due to problem in HttpUtils ", "1.6.0" => "22.05.2020 replace \" H\" with \"%20H\" in attachments due to problem in HttpUtils ",
"1.5.0" => "15.03.2020 slash commands set in interactive answer field 'value' will be executed ", "1.5.0" => "15.03.2020 slash commands set in interactive answer field 'value' will be executed ",
"1.4.0" => "15.03.2020 rename '1_sendItem' to 'asyncSendItem' because of Aesthetics ", "1.4.0" => "15.03.2020 rename '1_sendItem' to 'asyncSendItem' because of Aesthetics ",
@@ -63,7 +64,7 @@ our %SSChatBot_vNotesIntern = (
); );
# Versions History extern # Versions History extern
our %SSChatBot_vNotesExtern = ( my %SSChatBot_vNotesExtern = (
"1.4.0" => "15.03.2020 Command '1_sendItem' renamed to 'asyncSendItem' because of Aesthetics ", "1.4.0" => "15.03.2020 Command '1_sendItem' renamed to 'asyncSendItem' because of Aesthetics ",
"1.3.0" => "13.03.2020 The set command 'sendItem' was renamed to '1_sendItem' to avoid changing the botToken by chance. ". "1.3.0" => "13.03.2020 The set command 'sendItem' was renamed to '1_sendItem' to avoid changing the botToken by chance. ".
"Also attachments are allowed now in the '1_sendItem' command. ", "Also attachments are allowed now in the '1_sendItem' command. ",
@@ -115,7 +116,7 @@ sub SSChatBot_Initialize {
"httptimeout ". "httptimeout ".
$readingFnAttributes; $readingFnAttributes;
eval { FHEM::Meta::InitMod( __FILE__, $hash ) }; # für Meta.pm (https://forum.fhem.de/index.php/topic,97589.0.html) FHEM::Meta::InitMod( __FILE__, $hash ) if(!$modMetaAbsent); # für Meta.pm (https://forum.fhem.de/index.php/topic,97589.0.html)
return; return;
} }
@@ -236,7 +237,7 @@ return;
sub SSChatBot_Attr { sub SSChatBot_Attr {
my ($cmd,$name,$aName,$aVal) = @_; my ($cmd,$name,$aName,$aVal) = @_;
my $hash = $defs{$name}; my $hash = $defs{$name};
my ($do,$val,$cache); my ($do,$val);
# $cmd can be "del" or "set" # $cmd can be "del" or "set"
# $name is device name # $name is device name
@@ -262,13 +263,13 @@ sub SSChatBot_Attr {
} }
if ($cmd eq "set") { if ($cmd eq "set") {
if ($aName =~ m/httptimeout/) { if ($aName =~ m/httptimeout/x) {
unless ($aVal =~ /^\d+$/) { return "The Value for $aName is not valid. Use only figures 1-9 !";} unless ($aVal =~ /^\d+$/x) { return "The Value for $aName is not valid. Use only figures 1-9 !";}
} }
if ($aName =~ m/ownCommand([1-9][0-9]*)$/) { if ($aName =~ m/ownCommand([1-9][0-9]*)$/) {
my $num = $1; my $num = $1;
return "The value of $aName must start with a slash like \"/Weather \"." unless ($aVal =~ /^\/.*$/); return qq{The value of $aName must start with a slash like "/Weather ".} unless ($aVal =~ /^\/.*$/);
addToDevAttrList($name, "ownCommand".($num+1)); # add neue ownCommand dynamisch addToDevAttrList($name, "ownCommand".($num+1)); # add neue ownCommand dynamisch
} }
} }
@@ -277,15 +278,16 @@ return;
} }
################################################################ ################################################################
sub SSChatBot_Set { sub SSChatBot_Set { ## no critic 'complexity'
my ($hash, @a) = @_; my ($hash, @a) = @_;
return "\"set X\" needs at least an argument" if ( @a < 2 ); return qq{"set X" needs at least an argument} if ( @a < 2 );
my $name = $a[0]; my @items = @a;
my $opt = $a[1]; my $name = shift @a;
my $prop = $a[2]; my $opt = shift @a;
my $prop1 = $a[3]; my $prop = shift @a;
my $prop2 = $a[4]; my $prop1 = shift @a;
my $prop3 = $a[5]; my $prop2 = shift @a;
my $prop3 = shift @a;
my ($success,$setlist); my ($success,$setlist);
return if(IsDisabled($name)); return if(IsDisabled($name));
@@ -313,14 +315,14 @@ sub SSChatBot_Set {
if($success) { if($success) {
CommandGet(undef, "$name chatUserlist"); # Chatuser Liste abrufen CommandGet(undef, "$name chatUserlist"); # Chatuser Liste abrufen
return "botToken saved successfully"; return qq{botToken saved successfully};
} else { } else {
return "Error while saving botToken - see logfile for details"; return qq{Error while saving botToken - see logfile for details};
} }
} elsif ($opt eq "listSendqueue") { } elsif ($opt eq "listSendqueue") {
my $sub = sub ($) { my $sub = sub ($) {
my ($idx) = @_; my $idx = shift;
my $ret; my $ret;
foreach my $key (reverse sort keys %{$data{SSChatBot}{$name}{sendqueue}{entries}{$idx}}) { foreach my $key (reverse sort keys %{$data{SSChatBot}{$name}{sendqueue}{entries}{$idx}}) {
$ret .= ", " if($ret); $ret .= ", " if($ret);
@@ -330,7 +332,7 @@ sub SSChatBot_Set {
}; };
if (!keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) { if (!keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
return "SendQueue is empty."; return qq{SendQueue is empty.};
} }
my $sq; my $sq;
foreach my $idx (sort{$a<=>$b} keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) { foreach my $idx (sort{$a<=>$b} keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
@@ -344,15 +346,17 @@ sub SSChatBot_Set {
delete $data{SSChatBot}{$name}{sendqueue}{entries}; delete $data{SSChatBot}{$name}{sendqueue}{entries};
$data{SSChatBot}{$name}{sendqueue}{index} = 0; $data{SSChatBot}{$name}{sendqueue}{index} = 0;
return "All entries of SendQueue are deleted"; return "All entries of SendQueue are deleted";
} elsif($prop eq "-permError-") { } elsif($prop eq "-permError-") {
foreach my $idx (keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) { foreach my $idx (keys %{$data{SSChatBot}{$name}{sendqueue}{entries}}) {
delete $data{SSChatBot}{$name}{sendqueue}{entries}{$idx} delete $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}
if($data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{forbidSend}); if($data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{forbidSend});
} }
return "All entries with state \"permanent send error\" are deleted"; return qq{All entries with state "permanent send error" are deleted};
} else { } else {
delete $data{SSChatBot}{$name}{sendqueue}{entries}{$prop}; delete $data{SSChatBot}{$name}{sendqueue}{entries}{$prop};
return "SendQueue entry with index \"$prop\" deleted"; return qq{SendQueue entry with index "$prop" deleted};
} }
} elsif ($opt eq "asyncSendItem") { } elsif ($opt eq "asyncSendItem") {
@@ -361,11 +365,12 @@ sub SSChatBot_Set {
# text="<https://www.synology.com>" users="user1" # text="<https://www.synology.com>" users="user1"
# text="Check this!! <https://www.synology.com|Click here> for details!" users="user1,user2" # text="Check this!! <https://www.synology.com|Click here> for details!" users="user1,user2"
# text="a fun image" fileUrl="http://imgur.com/xxxxx" users="user1,user2" # text="a fun image" fileUrl="http://imgur.com/xxxxx" users="user1,user2"
return undef if(!$hash->{HELPER}{USERFETCHED}); return if(!$hash->{HELPER}{USERFETCHED});
my ($text,$users); my ($text,$users);
my ($fileUrl,$attachment) = ("",""); my ($fileUrl,$attachment) = ("","");
my $cmd = join(" ", map { $_ =~ s/\s//g; $_; } @a ); my $cmd = join(" ", map { my $p = $_; $p =~ s/\s//g; $p; } @items);
my ($a,$h) = parseParams($cmd); my ($arr,$h) = parseParams($cmd);
if($h) { if($h) {
$text = $h->{text} if(defined $h->{text}); $text = $h->{text} if(defined $h->{text});
$users = $h->{users} if(defined $h->{users}); $users = $h->{users} if(defined $h->{users});
@@ -373,8 +378,8 @@ sub SSChatBot_Set {
$attachment = SSChatBot_formString($h->{attachments}, "attachement") if(defined $h->{attachments}); $attachment = SSChatBot_formString($h->{attachments}, "attachement") if(defined $h->{attachments});
} }
if($a) { if($arr) {
my @t = @{$a}; my @t = @{$arr};
shift @t; shift @t; shift @t; shift @t;
$text = join(" ", @t) if(!$text); $text = join(" ", @t) if(!$text);
} }
@@ -392,7 +397,7 @@ sub SSChatBot_Set {
foreach (@ua) { foreach (@ua) {
next if(!$_); next if(!$_);
my $uid = $hash->{HELPER}{USERS}{$_}{id}; my $uid = $hash->{HELPER}{USERS}{$_}{id};
return "The receptor \"$_\" seems to be unknown because its ID coulnd't be found." if(!$uid); return qq{The receptor "$_" seems to be unknown because its ID coulnd't be found.} if(!$uid);
# Eintrag zur SendQueue hinzufügen # Eintrag zur SendQueue hinzufügen
# Werte: (name,opmode,method,userid,text,fileUrl,channel,attachment) # Werte: (name,opmode,method,userid,text,fileUrl,channel,attachment)
@@ -406,7 +411,7 @@ sub SSChatBot_Set {
if($ret) { if($ret) {
return $ret; return $ret;
} else { } else {
return "The SendQueue has been restarted."; return qq{The SendQueue has been restarted.};
} }
} else { } else {
@@ -417,7 +422,7 @@ return;
} }
################################################################ ################################################################
sub SSChatBot_Get { sub SSChatBot_Get { ## no critic 'complexity'
my ($hash, @a) = @_; my ($hash, @a) = @_;
return "\"get X\" needs at least an argument" if ( @a < 2 ); return "\"get X\" needs at least an argument" if ( @a < 2 );
my $name = shift @a; my $name = shift @a;
@@ -455,6 +460,7 @@ sub SSChatBot_Get {
} elsif ($opt eq "chatUserlist") { } elsif ($opt eq "chatUserlist") {
# übergebenen CL-Hash (FHEMWEB) in Helper eintragen # übergebenen CL-Hash (FHEMWEB) in Helper eintragen
SSChatBot_delclhash ($name);
SSChatBot_getclhash($hash,1); SSChatBot_getclhash($hash,1);
# Eintrag zur SendQueue hinzufügen # Eintrag zur SendQueue hinzufügen
@@ -465,6 +471,7 @@ sub SSChatBot_Get {
} elsif ($opt eq "chatChannellist") { } elsif ($opt eq "chatChannellist") {
# übergebenen CL-Hash (FHEMWEB) in Helper eintragen # übergebenen CL-Hash (FHEMWEB) in Helper eintragen
SSChatBot_delclhash ($name);
SSChatBot_getclhash($hash,1); SSChatBot_getclhash($hash,1);
# Eintrag zur SendQueue hinzufügen # Eintrag zur SendQueue hinzufügen
@@ -473,7 +480,7 @@ sub SSChatBot_Get {
SSChatBot_getapisites($name); SSChatBot_getapisites($name);
} elsif ($opt =~ /versionNotes/) { } elsif ($opt =~ /versionNotes/x) {
my $header = "<b>Module release information</b><br>"; my $header = "<b>Module release information</b><br>";
my $header1 = "<b>Helpful hints</b><br>"; my $header1 = "<b>Helpful hints</b><br>";
my %hs; my %hs;
@@ -485,12 +492,12 @@ sub SSChatBot_Get {
$ret = "<html>"; $ret = "<html>";
# Hints # Hints
if(!$arg || $arg =~ /hints/ || $arg =~ /[\d]+/) { if(!$arg || $arg =~ /hints/x || $arg =~ /[\d]+/x) {
$ret .= sprintf("<div class=\"makeTable wide\"; style=\"text-align:left\">$header1 <br>"); $ret .= sprintf("<div class=\"makeTable wide\"; style=\"text-align:left\">$header1 <br>");
$ret .= "<table class=\"block wide internals\">"; $ret .= "<table class=\"block wide internals\">";
$ret .= "<tbody>"; $ret .= "<tbody>";
$ret .= "<tr class=\"even\">"; $ret .= "<tr class=\"even\">";
if($arg && $arg =~ /[\d]+/) { if($arg && $arg =~ /[\d]+/x) {
my @hints = split(",",$arg); my @hints = split(",",$arg);
foreach (@hints) { foreach (@hints) {
if(AttrVal("global","language","EN") eq "DE") { if(AttrVal("global","language","EN") eq "DE") {
@@ -526,7 +533,7 @@ sub SSChatBot_Get {
} }
# Notes # Notes
if(!$arg || $arg =~ /rel/) { if(!$arg || $arg =~ /rel/x) {
$ret .= sprintf("<div class=\"makeTable wide\"; style=\"text-align:left\">$header <br>"); $ret .= sprintf("<div class=\"makeTable wide\"; style=\"text-align:left\">$header <br>");
$ret .= "<table class=\"block wide internals\">"; $ret .= "<table class=\"block wide internals\">";
$ret .= "<tbody>"; $ret .= "<tbody>";
@@ -585,7 +592,7 @@ sub SSChatBot_initonboot {
my $room = AttrVal($name, "room", "Chat"); my $room = AttrVal($name, "room", "Chat");
my $port = 8082; my $port = 8082;
while (grep(/^$port$/ , @FWports)) { # den ersten freien FHEMWEB-Port ab 8082 finden while (grep {/^$port$/} @FWports) { # den ersten freien FHEMWEB-Port ab 8082 finden
$port++; $port++;
} }
@@ -717,7 +724,7 @@ sub SSChatBot_checkretry {
my $rc = $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{retryCount}; my $rc = $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{retryCount};
my $errorcode = ReadingsVal($name, "Errorcode", 0); my $errorcode = ReadingsVal($name, "Errorcode", 0);
if($errorcode =~ /100|101|117|120|407|409|410|800|900/) { # bei diesen Errorcodes den Queueeintrag nicht wiederholen, da dauerhafter Fehler ! if($errorcode =~ /100|101|117|120|407|409|410|800|900/x) { # bei diesen Errorcodes den Queueeintrag nicht wiederholen, da dauerhafter Fehler !
$forbidSend = SSChatBot_experror($hash,$errorcode); # Fehlertext zum Errorcode ermitteln $forbidSend = SSChatBot_experror($hash,$errorcode); # Fehlertext zum Errorcode ermitteln
$data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{forbidSend} = $forbidSend; $data{SSChatBot}{$name}{sendqueue}{entries}{$idx}{forbidSend} = $forbidSend;
@@ -760,7 +767,6 @@ sub SSChatBot_checkretry {
return return
} }
sub SSChatBot_getapisites ($) { sub SSChatBot_getapisites ($) {
my ($name) = @_; my ($name) = @_;
my $hash = $defs{$name}; my $hash = $defs{$name};
@@ -972,7 +978,7 @@ sub SSChatBot_chatop {
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");
if ($opmode =~ /^chatUserlist$|^chatChannellist$/) { if ($opmode =~ /^chatUserlist$|^chatChannellist$/x) {
$url = "$inprot://$inaddr:$inport/webapi/$chatexternalpath?api=$chatexternal&version=$chatexternalmaxver&method=$method&token=\"$token\""; $url = "$inprot://$inaddr:$inport/webapi/$chatexternalpath?api=$chatexternal&version=$chatexternalmaxver&method=$method&token=\"$token\"";
} }
@@ -994,7 +1000,7 @@ sub SSChatBot_chatop {
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>/; $part =~ s/$token/<secret>/x;
Log3($name, 4, "$name - Call-Out: $part"); Log3($name, 4, "$name - Call-Out: $part");
} }
@@ -1015,7 +1021,7 @@ return;
############################################################################################# #############################################################################################
# Callback from SSChatBot_chatop # Callback from SSChatBot_chatop
############################################################################################# #############################################################################################
sub SSChatBot_chatop_parse { sub SSChatBot_chatop_parse { ## no critic 'complexity'
my ($param, $err, $myjson) = @_; my ($param, $err, $myjson) = @_;
my $hash = $param->{hash}; my $hash = $param->{hash};
my $name = $hash->{NAME}; my $name = $hash->{NAME};
@@ -1023,7 +1029,7 @@ sub SSChatBot_chatop_parse {
my $inaddr = $hash->{INADDR}; my $inaddr = $hash->{INADDR};
my $inport = $hash->{INPORT}; my $inport = $hash->{INPORT};
my $opmode = $hash->{OPMODE}; my $opmode = $hash->{OPMODE};
my ($rectime,$data,$success,$error,$errorcode,$cherror); my ($data,$success,$error,$errorcode,$cherror);
my $lang = AttrVal("global","language","EN"); my $lang = AttrVal("global","language","EN");
@@ -1032,7 +1038,7 @@ sub SSChatBot_chatop_parse {
Log3($name, 2, "$name - ERROR message: $err"); Log3($name, 2, "$name - ERROR message: $err");
$errorcode = "none"; $errorcode = "none";
$errorcode = "800" if($err =~ /: malformed or unsupported URL$/s); $errorcode = "800" if($err =~ /:\smalformed\sor\sunsupported\sURL$/xs);
readingsBeginUpdate ($hash); readingsBeginUpdate ($hash);
readingsBulkUpdateIfChanged ($hash, "Error", $err); readingsBulkUpdateIfChanged ($hash, "Error", $err);
@@ -1115,7 +1121,7 @@ sub SSChatBot_chatop_parse {
# Ausgabe Popup der User-Daten (nach readingsEndUpdate positionieren sonst # Ausgabe Popup der User-Daten (nach readingsEndUpdate positionieren sonst
# "Connection lost, trying reconnect every 5 seconds" wenn > 102400 Zeichen) # "Connection lost, trying reconnect every 5 seconds" wenn > 102400 Zeichen)
asyncOutput($hash->{HELPER}{CL}{1},"$out"); asyncOutput($hash->{HELPER}{CL}{1},"$out");
delete($hash->{HELPER}{CL}); InternalTimer(gettimeofday()+10.0, "SSChatBot_delclhash", $name, 0);
} elsif ($opmode eq "chatChannellist") { } elsif ($opmode eq "chatChannellist") {
my %channels = (); my %channels = ();
@@ -1153,7 +1159,7 @@ sub SSChatBot_chatop_parse {
# Ausgabe Popup der User-Daten (nach readingsEndUpdate positionieren sonst # Ausgabe Popup der User-Daten (nach readingsEndUpdate positionieren sonst
# "Connection lost, trying reconnect every 5 seconds" wenn > 102400 Zeichen) # "Connection lost, trying reconnect every 5 seconds" wenn > 102400 Zeichen)
asyncOutput($hash->{HELPER}{CL}{1},"$out"); asyncOutput($hash->{HELPER}{CL}{1},"$out");
delete($hash->{HELPER}{CL}); InternalTimer(gettimeofday()+5.0, "SSChatBot_delclhash", $name, 0);
} elsif ($opmode eq "sendItem" && $hash->{OPIDX}) { } elsif ($opmode eq "sendItem" && $hash->{OPIDX}) {
my $postid = ""; my $postid = "";
@@ -1491,7 +1497,7 @@ sub SSChatBot_formString {
$txt .= $_; $txt .= $_;
} }
$pat = join '|', map quotemeta, keys(%replacements); $pat = join '|', map { quotemeta; } keys(%replacements);
$txt =~ s/($pat)/$replacements{$1}/g; $txt =~ s/($pat)/$replacements{$1}/g;
@@ -1511,7 +1517,7 @@ sub SSChatBot_getclhash {
# nur übergebenen CL-Hash speichern, # nur übergebenen CL-Hash speichern,
# keine Hintergrundverarbeitung bzw. synthetische Erstellung CL-Hash # keine Hintergrundverarbeitung bzw. synthetische Erstellung CL-Hash
$hash->{HELPER}{CL}{1} = $hash->{CL}; $hash->{HELPER}{CL}{1} = $hash->{CL};
return undef; return;
} }
if (!defined($hash->{CL})) { if (!defined($hash->{CL})) {
@@ -1549,6 +1555,18 @@ sub SSChatBot_getclhash {
return ($ret); return ($ret);
} }
#############################################################################################
# Clienthash löschen
#############################################################################################
sub SSChatBot_delclhash {
my $name = shift;
my $hash = $defs{$name};
delete($hash->{HELPER}{CL});
return;
}
############################################################################################# #############################################################################################
# Versionierungen des Moduls setzen # Versionierungen des Moduls setzen
# Die Verwendung von Meta.pm und Packages wird berücksichtigt # Die Verwendung von Meta.pm und Packages wird berücksichtigt
@@ -1566,7 +1584,7 @@ sub SSChatBot_setVersionInfo {
# META-Daten sind vorhanden # META-Daten sind vorhanden
$modules{$type}{META}{version} = "v".$v; # Version aus META.json überschreiben, Anzeige mit {Dumper $modules{SSChatBot}{META}} $modules{$type}{META}{version} = "v".$v; # Version aus META.json überschreiben, Anzeige mit {Dumper $modules{SSChatBot}{META}}
if($modules{$type}{META}{x_version}) { # {x_version} ( nur gesetzt wenn $Id: 50_SSChatBot.pm 20534 2019-11-18 17:50:17Z DS_Starter $ im Kopf komplett! vorhanden ) if($modules{$type}{META}{x_version}) { # {x_version} ( nur gesetzt wenn $Id: 50_SSChatBot.pm 20534 2019-11-18 17:50:17Z DS_Starter $ im Kopf komplett! vorhanden )
$modules{$type}{META}{x_version} =~ s/1.1.1/$v/g; $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;
} }
@@ -1574,7 +1592,7 @@ sub SSChatBot_setVersionInfo {
if(__PACKAGE__ eq "FHEM::$type" || __PACKAGE__ eq $type) { if(__PACKAGE__ eq "FHEM::$type" || __PACKAGE__ eq $type) {
# es wird mit Packages gearbeitet -> Perl übliche Modulversion setzen # es wird mit Packages gearbeitet -> Perl übliche Modulversion setzen
# mit {<Modul>->VERSION()} im FHEMWEB kann Modulversion abgefragt werden # mit {<Modul>->VERSION()} im FHEMWEB kann Modulversion abgefragt werden
use version 0.77; our $VERSION = FHEM::Meta::Get( $hash, 'version' ); use version 0.77; our $VERSION = FHEM::Meta::Get( $hash, 'version' ); ## no critic 'VERSION'
} }
} else { } else {
# herkömmliche Modulstruktur # herkömmliche Modulstruktur
@@ -1588,7 +1606,7 @@ return;
# Common Gateway Interface # Common Gateway Interface
# parsen von outgoing Messages Chat -> FHEM # parsen von outgoing Messages Chat -> FHEM
############################################################################################# #############################################################################################
sub SSChatBot_CGI { sub SSChatBot_CGI { ## no critic 'complexity'
my ($request) = @_; my ($request) = @_;
my ($hash,$name,$link,$args); my ($hash,$name,$link,$args);
my ($text,$timestamp,$channelid,$channelname,$userid,$username,$postid,$triggerword) = ("","","","","","","",""); my ($text,$timestamp,$channelid,$channelname,$userid,$username,$postid,$triggerword) = ("","","","","","","","");