mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-01-31 12:49:34 +00:00
95_Babble.pm: Neue Version mit RiveScript ChatBot
git-svn-id: https://svn.fhem.de/fhem/trunk@16150 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
parent
e08e5e8d01
commit
621d747fb3
@ -36,13 +36,24 @@ use vars qw(%intAt); # FHEM at definitions
|
||||
use vars qw($FW_ME);
|
||||
|
||||
use JSON; # imports encode_json, decode_json, to_json and from_json.
|
||||
my $rive = 0;
|
||||
my $riveinterpreter;
|
||||
#-- RiveScript missing in System
|
||||
if (eval {require RiveScript;1;} ne 1) {
|
||||
Log 1,"[Babble] the RiveScript module is missing from your Perl installation - chatbot functionality not available";
|
||||
Log 1," check cpan or https://github.com/aichaos/rivescript-perl for download and installation";
|
||||
} else {
|
||||
RiveScript->import();
|
||||
$rive = 1;
|
||||
Log 1,"[Babble] the RiveScript module has been imported successfully, chatbot functionality available";
|
||||
}
|
||||
|
||||
#########################
|
||||
# Global variables
|
||||
my $babblelinkname = "babbles"; # link text
|
||||
my $babblehiddenroom = "babbleRoom"; # hidden room
|
||||
my $babblepublicroom = "babble"; # public room
|
||||
my $babbleversion = "1.09";
|
||||
my $babbleversion = "1.1";
|
||||
|
||||
my %babble_transtable_EN = (
|
||||
"ok" => "OK",
|
||||
@ -78,6 +89,7 @@ my %babble_transtable_EN = (
|
||||
"speak" => "Speak",
|
||||
"followedby" => "followed by",
|
||||
"placespec" => "a place specification",
|
||||
"dnu" => "Sorry, I did not understand this",
|
||||
"input" => "Input",
|
||||
"test" => "Test",
|
||||
"exec" => "Execute",
|
||||
@ -90,6 +102,7 @@ my %babble_transtable_EN = (
|
||||
"babbles" => "Babble System",
|
||||
"setparms" => "Set Parameters",
|
||||
#--
|
||||
"hallo" => "Hallo",
|
||||
"state" => "Security",
|
||||
"unlocked" => "Unlocked",
|
||||
"locked" => "Locked"
|
||||
@ -129,6 +142,7 @@ my %babble_transtable_EN = (
|
||||
"speak" => "Sprich",
|
||||
"followedby" => "gefolgt von",
|
||||
"placespec" => "einer Ortsangabe",
|
||||
"dnu" => "Es tut mir leid, das habe ich nicht verstanden",
|
||||
"input" => "Input",
|
||||
"test" => "Test",
|
||||
"exec" => "Ausführung",
|
||||
@ -141,6 +155,7 @@ my %babble_transtable_EN = (
|
||||
"babbles" => "Babble",
|
||||
"setparms" => "Parameter setzen",
|
||||
#--
|
||||
"hallo" => "Hallo",
|
||||
"state" => "Sicherheit",
|
||||
"unlocked" => "Unverschlossen",
|
||||
"locked" => "Verschlossen"
|
||||
@ -164,9 +179,9 @@ sub Babble_Initialize ($) {
|
||||
$hash->{GetFn} = "Babble_Get";
|
||||
$hash->{UndefFn} = "Babble_Undef";
|
||||
#$hash->{AttrFn} = "Babble_Attr";
|
||||
my $attst = "lockstate:locked,unlocked helpFunc testParm0 testParm1 testParm2 testParm3 ".
|
||||
my $attst = "lockstate:locked,unlocked helpFunc noChatBot:0,1 testParm0 testParm1 testParm2 testParm3 ".
|
||||
"remoteFHEM0 remoteFHEM1 remoteFHEM2 remoteFHEM3 remoteFunc0 remoteFunc1 remoteFunc2 remoteFunc3 remoteToken0 remoteToken1 remoteToken2 remoteToken3 ".
|
||||
"babbleDevices babblePlaces babbleNotPlaces babbleVerbs babbleVerbParts babblePrepos babbleQuests babbleArticles babbleStatus babbleWrites babbleTimes";
|
||||
"babbleIds babbleDevices babblePlaces babbleNotPlaces babbleVerbs babbleVerbParts babblePrepos babbleQuests babbleArticles babbleStatus babbleWrites babbleTimes";
|
||||
$hash->{AttrList} = $attst;
|
||||
|
||||
if( !defined($babble_tt) ){
|
||||
@ -181,8 +196,12 @@ sub Babble_Initialize ($) {
|
||||
$babblelinkname = $babble_tt->{"babbles"};
|
||||
|
||||
$data{FWEXT}{babblex}{LINK} = "?room=".$babblehiddenroom;
|
||||
$data{FWEXT}{babblex}{NAME} = $babblelinkname;
|
||||
|
||||
$data{FWEXT}{babblex}{NAME} = $babblelinkname;
|
||||
|
||||
#-- Create a new RiveScript interpreter
|
||||
Babble_createRive($hash)
|
||||
if( $rive==1 && !defined($hash->{Rive})) ;
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
@ -217,10 +236,12 @@ sub Babble_Define ($$) {
|
||||
$attr{$name}{"room"} = $babblehiddenroom;;
|
||||
|
||||
my $date = Babble_restore($hash,0);
|
||||
|
||||
#-- data seems to be ok, restore
|
||||
if( defined($date) ){
|
||||
Babble_restore($hash,1);
|
||||
Log3 $name,1,"[Babble_Define] data hash restored from save file with date $date";
|
||||
|
||||
#-- intialization
|
||||
}else{
|
||||
$hash->{DATA}{"devs"}=();
|
||||
@ -236,6 +257,10 @@ sub Babble_Define ($$) {
|
||||
Babble_checkattrs($hash);
|
||||
Log3 $name,1,"[Babble_Define] data hash is initialized";
|
||||
}
|
||||
|
||||
#-- Create a new RiveScript interpreter
|
||||
Babble_createRive($hash)
|
||||
if( $rive==1 && !defined($hash->{Rive})) ;
|
||||
|
||||
$modules{babble}{defptr}{$name} = $hash;
|
||||
|
||||
@ -347,7 +372,11 @@ sub Babble_Set($@) {
|
||||
} elsif ( $cmd =~ /^unlock(ed)?$/ ) {
|
||||
readingsSingleUpdate( $hash, "lockstate", "unlocked", 0 );
|
||||
return;
|
||||
#-----------------------------------------------------------
|
||||
#-----------------------------------------------------------
|
||||
} elsif ( $cmd =~ /^rivereload/ ) {
|
||||
delete $hash->{Rive};
|
||||
return Babble_createRive($hash);
|
||||
#-----------------------------------------------------------
|
||||
} elsif ( $cmd =~ /^test/ ) {
|
||||
return Babble_Test($hash);
|
||||
|
||||
@ -360,8 +389,10 @@ sub Babble_Set($@) {
|
||||
return Babble_restore($hash,1);
|
||||
|
||||
} else {
|
||||
my $str = "";
|
||||
return "[babble] Unknown argument " . $cmd . ", choose one of locked:noArg unlocked:noArg save:noArg restore:noArg test:noArg";
|
||||
my $str = "[babble] Unknown argument " . $cmd . ", choose one of locked:noArg unlocked:noArg save:noArg restore:noArg test:noArg ";
|
||||
$str .= "rivereload:noArg"
|
||||
if($rive == 1 && AttrVal($name,"noChatBot",0) != 1);
|
||||
return $str;
|
||||
}
|
||||
}
|
||||
|
||||
@ -405,12 +436,18 @@ sub Babble_Get($@) {
|
||||
sub Babble_save($) {
|
||||
my ($hash) = @_;
|
||||
my $date = localtime(time);
|
||||
my $name = $hash->{NAME};
|
||||
$hash->{DATA}{"savedate"} = $date;
|
||||
readingsSingleUpdate( $hash, "savedate", $hash->{DATA}{"savedate"}, 1 );
|
||||
my $json = JSON->new->utf8;
|
||||
my $jhash0 = eval{ $json->encode( $hash->{DATA} ) };
|
||||
my $error = FileWrite("babbleFILE",$jhash0);
|
||||
#Log 1,"[Babble_save] error=$error";
|
||||
if( ReadingsVal($name,"lockstate","locked") ne "locked" ){
|
||||
my $error = FileWrite("babbleFILE",$jhash0);
|
||||
#Log3 $name,1,"[Babble_save] error=$error";
|
||||
}else{
|
||||
Log3 $name, 1, "[Babble] attempt to save data failed due to lockstate";
|
||||
Log3 $name, 5, " ".Dumper($jhash0);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
@ -431,13 +468,13 @@ sub Babble_savename($){
|
||||
sub Babble_restore($$) {
|
||||
my ($hash,$doit) = @_;
|
||||
my $name = $hash->{NAME};
|
||||
my ($error,$jhash0) = FileRead("babbleFILE");
|
||||
my ($error,@lines) = FileRead("babbleFILE");
|
||||
if( defined($error) && $error ne "" ){
|
||||
Log3 $name,1,"[Babble_restore] read error=$error";
|
||||
return undef;
|
||||
}
|
||||
my $json = JSON->new->utf8;
|
||||
my $jhash1 = eval{ $json->decode( $jhash0 ) };
|
||||
my $jhash1 = eval{ $json->decode( join('',@lines) ) };
|
||||
my $date = $jhash1->{"savedate"};
|
||||
#-- just for the first time, reading an old savefile
|
||||
$date = localtime(time)
|
||||
@ -445,7 +482,7 @@ sub Babble_restore($$) {
|
||||
readingsSingleUpdate( $hash, "savedate", $date, 0 );
|
||||
if( $doit==1 ){
|
||||
$hash->{DATA} = {%{$jhash1}};
|
||||
Log3 $name,5,"[Babble_restore] Data hash restored from save file with date ".$date;
|
||||
Log3 $name,1,"[Babble_restore] Data hash restored from save file with date ".$date;
|
||||
return 1;
|
||||
}else{
|
||||
return $date;
|
||||
@ -537,8 +574,8 @@ sub Babble_Test($) {
|
||||
$str .= "\n";
|
||||
$str .= "\nI.1:".Babble_TestIt($name,"schalte beleuchtung in sitzgruppe an",0);
|
||||
$str .= "\nI.2:".Babble_TestIt($name,"schalte beleuchtung in der sitzgruppe an",0);
|
||||
$str .= "\nI.3:".Babble_TestIt($name,"mach die außenbeleuchtung auf terrasse an",0);
|
||||
$str .= "\nI.4:".Babble_TestIt($name,"mache die außenbeleuchtung aus",0);
|
||||
$str .= "\nI.3:".Babble_TestIt($name,"mach die beleuchtung auf terrasse an",0);
|
||||
$str .= "\nI.4:".Babble_TestIt($name,"mache außen die beleuchtung aus",0);
|
||||
$str .= "\nI.5:".Babble_TestIt($name,"wie ist die temperatur im badezimmer",0);
|
||||
$str .= "\nI.6:".Babble_TestIt($name,"wie ist die feuchte in dominics zimmer",0);
|
||||
$str .= "\nI.7:".Babble_TestIt($name,"wie ist die feuchte in dem schlafzimmer",0);
|
||||
@ -629,7 +666,6 @@ sub Babble_Normalize($$){
|
||||
if( int(@word) == 0){
|
||||
return ("","","","","","","");
|
||||
|
||||
|
||||
#-- Kategorie 1: Verb zuerst ----------------------------------------------------------
|
||||
# schalte das gerät an
|
||||
# schalte gerät an
|
||||
@ -712,61 +748,73 @@ sub Babble_Normalize($$){
|
||||
$reading = $word[$inext+1];
|
||||
#-- check time => device is reading
|
||||
if( $word[$inext+2] =~ /^$hash->{DATA}{"re_times"}/){
|
||||
$subsubcat = 1;
|
||||
$value = $word[$inext+2];
|
||||
$device = $reading;
|
||||
#-- check time => device is reading
|
||||
}elsif( $word[$inext+2] =~ /^$hash->{DATA}{"re_prepos"}/ && $word[$inext+3] =~ /^$hash->{DATA}{"re_times"}/){
|
||||
$subsubcat = 2;
|
||||
$value = $word[$inext+3];
|
||||
$device = $reading;
|
||||
#--take out preposition
|
||||
}elsif( $word[$inext+2] =~ /^$hash->{DATA}{"re_prepos"}/ ){
|
||||
if( $word[$inext+3] =~ /^$hash->{DATA}{"re_articles"}/){
|
||||
$subsubcat = 1;
|
||||
$subsubcat = 3;
|
||||
$article = $word[$inext+3];
|
||||
$device = $word[$inext+4];
|
||||
}else{
|
||||
$subsubcat = 2;
|
||||
$subsubcat = 4;
|
||||
$device = $word[$inext+3];
|
||||
}
|
||||
#-- no preposition
|
||||
}else{
|
||||
if( $word[$inext+2] =~ /^$hash->{DATA}{"re_articles"}/){
|
||||
$subsubcat = 3;
|
||||
$subsubcat = 5;
|
||||
$article = $word[$inext+2];
|
||||
$device = $word[$inext+3];
|
||||
}else{
|
||||
$subsubcat = 4;
|
||||
$subsubcat = 6;
|
||||
$device = $word[$inext+2];
|
||||
}
|
||||
}
|
||||
#-- no article
|
||||
}else{
|
||||
$subcat=2;
|
||||
$reading = $word[$inext];
|
||||
$reading = $word[$inext];
|
||||
#-- check time => device is reading
|
||||
if( $word[$inext+1] =~ /^$hash->{DATA}{"re_times"}/){
|
||||
$subsubcat = 1;
|
||||
$value = $word[$inext+1];
|
||||
$device = $reading;
|
||||
#-- check time => device is reading
|
||||
}elsif( $word[$inext+1] =~ /^$hash->{DATA}{"re_prepos"}/ && $word[$inext+2] =~ /^$hash->{DATA}{"re_times"}/){
|
||||
$subsubcat = 2;
|
||||
$value = $word[$inext+2];
|
||||
$device = $reading;
|
||||
#--take out preposition
|
||||
}elsif( $word[$inext+1] =~ /^$hash->{DATA}{"re_prepos"}/ ){
|
||||
if( $word[$inext+2] =~ /^$hash->{DATA}{"re_articles"}/){
|
||||
$subsubcat = 1;
|
||||
$subsubcat = 3;
|
||||
$article = $word[$inext+2];
|
||||
$device = $word[$inext+3];
|
||||
}else{
|
||||
$subsubcat = 2;
|
||||
$subsubcat = 4;
|
||||
$device = $word[$inext+2];
|
||||
}
|
||||
#-- no preposition
|
||||
}else{
|
||||
if( $word[$inext+1] =~ /^$hash->{DATA}{"re_articles"}/){
|
||||
$subsubcat = 3;
|
||||
$subsubcat = 5;
|
||||
$article = $word[$inext+1];
|
||||
$device = $word[$inext+2];
|
||||
}else{
|
||||
$subsubcat = 4;
|
||||
$subsubcat = 6;
|
||||
$device = $word[$inext+1];
|
||||
}
|
||||
}
|
||||
}
|
||||
if( $device eq ""){
|
||||
$subsubcat = 6;
|
||||
$subsubcat = 7;
|
||||
$device = $reading;
|
||||
$reading = "status";
|
||||
}
|
||||
@ -826,7 +874,8 @@ sub Babble_Normalize($$){
|
||||
}else{
|
||||
$subsubcat = 5;
|
||||
$reserve =~ /^$rex/;
|
||||
$verb = $11; #No verb_prt +2 TODO
|
||||
#-- named group
|
||||
$verb = $+{verbsi};
|
||||
$reading = $1;
|
||||
}
|
||||
#-- status [prepo] (device)
|
||||
@ -859,7 +908,7 @@ sub Babble_Normalize($$){
|
||||
#-- (device) [prepo] (time)
|
||||
if( $reserve =~ /^$hash->{DATA}{"re_times"}/ ){
|
||||
$subsubcat = 3;
|
||||
#$reading = $reserve;
|
||||
$reading = "status";
|
||||
$value = $reserve;
|
||||
$verb = "sagen";
|
||||
#-- (device) [prepo] status
|
||||
@ -887,7 +936,8 @@ sub Babble_Normalize($$){
|
||||
}else{
|
||||
$subsubcat = 7;
|
||||
$reserve =~ /^$rex/;
|
||||
$verb = $11; #No verb_prt +2
|
||||
#-- named group
|
||||
$verb = $+{verbsi};
|
||||
$reading = $1;
|
||||
}
|
||||
#-- (device)
|
||||
@ -919,30 +969,36 @@ sub Babble_Normalize($$){
|
||||
|
||||
#-- machen
|
||||
$verb = "schalten"
|
||||
if( $verb eq "machen");
|
||||
if( $verb && $verb eq "machen");
|
||||
|
||||
#-- sichern
|
||||
$reading = "zu"
|
||||
if(( $verb eq "sichern") && ($reading eq ""));
|
||||
if(( $verb && $verb eq "sichern") && ($reading eq ""));
|
||||
|
||||
#-- an
|
||||
$reading = "status"
|
||||
if( (($verb eq "sagen") || ($verb eq "zeigen")) && ($reading eq "an"));
|
||||
if( (( $verb && $verb eq "sagen") || ( $verb && $verb eq "zeigen")) && ($reading eq "an"));
|
||||
$reading = "an"
|
||||
if( $reading eq "ein");
|
||||
if( $reading && $reading eq "ein");
|
||||
|
||||
#-- value
|
||||
$value=substr($sentmod,index($sentmod,"auf")+4)
|
||||
if( ($reading eq "auf") || ($reserve eq "auf") );
|
||||
if( ($reading && $reading eq "auf") || ($reserve && $reserve eq "auf") );
|
||||
|
||||
if( $value =~ /.*uhr.*/ ){
|
||||
$value = timecorrector($value);
|
||||
$value = Babble_timecorrector($value);
|
||||
}
|
||||
|
||||
return ($device,$verb,$reading,$value,$article,$reserve,$place,"$cat.$subcat.$subsubcat");
|
||||
}
|
||||
|
||||
sub timecorrector($){
|
||||
#########################################################################################
|
||||
#
|
||||
# Babble_timecorrector - to correct for weird answers from Google
|
||||
#
|
||||
#########################################################################################
|
||||
|
||||
sub Babble_timecorrector($){
|
||||
my ($value) = @_;
|
||||
my ($h,$m1,$m2);
|
||||
#-- xx:yy uhr und zz uhr
|
||||
@ -969,6 +1025,29 @@ sub timecorrector($){
|
||||
}
|
||||
}
|
||||
|
||||
#########################################################################################
|
||||
#
|
||||
# Babble_createRive
|
||||
#
|
||||
#########################################################################################
|
||||
|
||||
sub Babble_createRive($){
|
||||
my ($hash) = @_;
|
||||
|
||||
my $name = $hash->{NAME};
|
||||
my $rs = $hash->{Rive};
|
||||
if( !defined($rs) ){
|
||||
$rs = new RiveScript(utf8=>1);
|
||||
$hash->{Rive} = $rs;
|
||||
Log3 $name, 1, "[Babble] new RiveScript interpreter generated";
|
||||
}
|
||||
#--load a directory of replies
|
||||
eval{$rs->loadDirectory ("./rivescript")};
|
||||
|
||||
#-- sort all the loaded replies
|
||||
$rs->sortReplies;
|
||||
}
|
||||
|
||||
#########################################################################################
|
||||
#
|
||||
# Babble_getcsrf
|
||||
@ -1004,6 +1083,10 @@ sub Babble_TestIt{
|
||||
my $hash = $defs{$name};
|
||||
|
||||
my ($device,$verb,$reading,$value,$article,$reserve,$place,$cat) = Babble_Normalize($name,$sentence);
|
||||
$verb = ""
|
||||
if( !$verb );
|
||||
$reading = ""
|
||||
if( !$reading );
|
||||
|
||||
my $str="[Babble_Normalize] ".$babble_tt->{"input"}.": $sentence\n".
|
||||
" ".$babble_tt->{"result"}.": Category=$cat: ".
|
||||
@ -1031,7 +1114,7 @@ sub Babble_TestIt{
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#-- command found, execute if permitted
|
||||
if( defined($cmd) && $cmd ne "" ){
|
||||
#-- substitution
|
||||
$cmd =~ s/\$DEV/$device/g;
|
||||
@ -1064,7 +1147,45 @@ sub Babble_TestIt{
|
||||
});
|
||||
}
|
||||
}
|
||||
#-- confirm execution
|
||||
my $func = AttrVal($name,"helpFunc",undef);
|
||||
if( $func && $func ne "" ){
|
||||
$func =~ s/\$HELP/OhKee/g;
|
||||
$res = eval($func);
|
||||
}
|
||||
}
|
||||
|
||||
#-- no command found, but chatbot available
|
||||
}elsif( $rive==1 && AttrVal($name,"noChatBot",0) != 1){
|
||||
#-- Create a new RiveScript interpreter
|
||||
Babble_createRive($hash)
|
||||
if( !defined($hash->{Rive}) );
|
||||
|
||||
chomp ($sentence);
|
||||
my $rs = $hash->{Rive};
|
||||
my $reply = $rs->reply ('localuser',$sentence);
|
||||
$reply = $babble_tt->{dnu}
|
||||
if ($reply eq "ERR: No Reply Matched");
|
||||
$str .= "==> ".$reply;
|
||||
|
||||
if( $exflag==1 ){
|
||||
my $func = AttrVal($name,"helpFunc",undef);
|
||||
if( $func && $func ne "" ){
|
||||
#-- substitution
|
||||
$func =~ s/\$DEV/$device/g;
|
||||
$func =~ s/\$VALUE/$value/g;
|
||||
for( my $i=0;$i<4;$i++){
|
||||
$parms[$i] = AttrVal($name,"testParm".$i,undef)
|
||||
if( !defined($parms[$i]) && AttrVal($name,"testParm".$i,undef));
|
||||
}
|
||||
for(my $i=0;$i<int(@parms);$i++){
|
||||
$func =~ s/\$PARM$i/$parms[$i]/g;
|
||||
}
|
||||
$func =~ s/\$HELP/$reply/g;
|
||||
$res = eval($func);
|
||||
}
|
||||
}
|
||||
#-- no command found and chatbot unavailable
|
||||
}elsif( $exflag==1 ){
|
||||
my $func = AttrVal($name,"helpFunc",undef);
|
||||
if( $func && $func ne "" ){
|
||||
@ -1126,32 +1247,55 @@ sub Babble_DoIt{
|
||||
}
|
||||
|
||||
if( defined($cmd) && $cmd ne "" ){
|
||||
#-- substitution
|
||||
$cmd =~ s/\$DEV/$device/g;
|
||||
$cmd =~ s/\$VALUE/$value/g;
|
||||
for(my $i=0;$i<int(@parms);$i++){
|
||||
$cmd =~ s/\$PARM$i/$parms[$i]/g;
|
||||
}
|
||||
Log 1,"[Babble_DoIt] Executing from hash: $device.$place.$verb.$reading/$value";
|
||||
my $contact = $hash->{DATA}{"devcontacts"}{$device}[2];
|
||||
my $fhemdev = $hash->{DATA}{"devcontacts"}{$device}[1];
|
||||
if( $contact == 0 ){
|
||||
$res = fhem($cmd);
|
||||
}else{
|
||||
my $ip = AttrVal($name,"remoteFHEM".$contact,undef);
|
||||
my $token = AttrVal($name,"remoteToken".$contact,undef);
|
||||
my $func = AttrVal($name,"remoteFunc".$contact,undef);
|
||||
if( $func && $func ne "" ){
|
||||
$res = eval($func."(\"".$cmd."\")")
|
||||
}else{
|
||||
$cmd =~ s/\s/\%20/g;
|
||||
my $url = "http://".$ip."/fhem?XHR=1&fwcsrf=".$token."&cmd.$fhemdev=$cmd";
|
||||
HttpUtils_NonblockingGet({
|
||||
url => $url,
|
||||
callback => sub($$$){}
|
||||
});
|
||||
}
|
||||
}
|
||||
#-- substitution
|
||||
$cmd =~ s/\$DEV/$device/g;
|
||||
$cmd =~ s/\$VALUE/$value/g;
|
||||
for(my $i=0;$i<int(@parms);$i++){
|
||||
$cmd =~ s/\$PARM$i/$parms[$i]/g;
|
||||
}
|
||||
Log 1,"[Babble_DoIt] Executing from hash: $device.$place.$verb.$reading/$value";
|
||||
my $contact = $hash->{DATA}{"devcontacts"}{$device}[2];
|
||||
my $fhemdev = $hash->{DATA}{"devcontacts"}{$device}[1];
|
||||
if( $contact == 0 ){
|
||||
$res = fhem($cmd);
|
||||
}else{
|
||||
my $ip = AttrVal($name,"remoteFHEM".$contact,undef);
|
||||
my $token = AttrVal($name,"remoteToken".$contact,undef);
|
||||
my $func = AttrVal($name,"remoteFunc".$contact,undef);
|
||||
if( $func && $func ne "" ){
|
||||
$res = eval($func."(\"".$cmd."\")")
|
||||
}else{
|
||||
$cmd =~ s/\s/\%20/g;
|
||||
my $url = "http://".$ip."/fhem?XHR=1&fwcsrf=".$token."&cmd.$fhemdev=$cmd";
|
||||
HttpUtils_NonblockingGet({
|
||||
url => $url,
|
||||
callback => sub($$$){}
|
||||
});
|
||||
}
|
||||
}
|
||||
#-- confirm execution
|
||||
my $func = AttrVal($name,"helpFunc",undef);
|
||||
if( $func && $func ne "" ){
|
||||
$func =~ s/\$HELP/OhKee/g;
|
||||
$res = eval($func);
|
||||
}
|
||||
#-- no command found, but chatbot available
|
||||
}elsif( $rive==1 && AttrVal($name,"noChatBot",0) != 1){
|
||||
#-- Create a new RiveScript interpreter
|
||||
Babble_createRive($hash)
|
||||
if( !defined($hash->{Rive}) );
|
||||
|
||||
chomp ($sentence);
|
||||
my $rs = $hash->{Rive};
|
||||
my $reply = $rs->reply ('localuser',$sentence);
|
||||
$reply = $babble_tt->{dnu}
|
||||
if ($reply eq "ERR: No Reply Matched");
|
||||
my $func = AttrVal($name,"helpFunc",undef);
|
||||
if( $func && $func ne "" ){
|
||||
$func =~ s/\$HELP/$reply/g;
|
||||
$res = eval($func)
|
||||
}
|
||||
#-- no command found and chatbot unavailable
|
||||
}else{
|
||||
my $func = AttrVal($name,"helpFunc",undef);
|
||||
if( $func && $func ne "" ){
|
||||
@ -1281,7 +1425,6 @@ sub Babble_ModVerb($$$$){
|
||||
CommandAttr (undef,$name." babbleVerbs ".$att);
|
||||
Babble_getverbs($hash,"new",undef);
|
||||
Babble_save($hash);
|
||||
|
||||
}
|
||||
|
||||
########################################################################################
|
||||
@ -1371,6 +1514,37 @@ sub Babble_RemCmd($$$$$){
|
||||
|
||||
}
|
||||
|
||||
#########################################################################################
|
||||
#
|
||||
# Babble_getids - Helper function to assemble id list
|
||||
#
|
||||
# Parameter hash = hash of device addressed
|
||||
#
|
||||
#########################################################################################
|
||||
|
||||
sub Babble_getids($$) {
|
||||
my ($hash,$type) = @_;
|
||||
|
||||
my $name = $hash->{NAME};
|
||||
my $res = "";
|
||||
|
||||
# @{$hash->{DATA}{"ids"}} = array of all ids
|
||||
my @ids;
|
||||
|
||||
#--generate a new list
|
||||
if( $type eq "new" ){
|
||||
push(@ids,$babble_tt->{"hallo"});
|
||||
#-- get ids from attribute
|
||||
push(@ids,split(' ',AttrVal($name, "babbleIds", "")));
|
||||
|
||||
$hash->{DATA}{"re_ids"} = lc("((".join(")|(",@ids)."))");
|
||||
return;
|
||||
#-- just do something with the current list
|
||||
}else{
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
#########################################################################################
|
||||
#
|
||||
# Babble_getdevs - Helper function to assemble devices list
|
||||
@ -1496,7 +1670,7 @@ sub Babble_antistupidity($) {
|
||||
my $devs = $hash->{DATA}{"devs"};
|
||||
return
|
||||
if( !defined($regexp) || !defined($devs) );
|
||||
my $imax = int(@{$devs});
|
||||
my $imax = int(@{$hash->{DATA}{"devs"}});
|
||||
for( my $i=0; $i<$imax; $i++){
|
||||
my $dev = lc($hash->{DATA}{"devs"}[$i]);
|
||||
Log 1,"[Babble] Baaaaah ! It is not a good idea to name a device $dev similar to a place in Babble"
|
||||
@ -1631,7 +1805,7 @@ sub Babble_getverbs($$$) {
|
||||
$hash->{DATA}{"verbsicc"}[$i][$j] = $vcc
|
||||
}
|
||||
}
|
||||
$hash->{DATA}{"re_verbsi"} = lc("((".join(")|(",@{$hash->{DATA}{"verbsi"}})."))");
|
||||
$hash->{DATA}{"re_verbsi"} = "(?P<verbsi>(".lc( join(")|(",@{$hash->{DATA}{"verbsi"}}))."))";
|
||||
$hash->{DATA}{"re_verbsc"} = lc("((".join(")|(",(keys %{$hash->{DATA}{"verbs"}}))."))");
|
||||
return;
|
||||
#-- just do something with the current list
|
||||
@ -1761,6 +1935,7 @@ sub Babble_Html($)
|
||||
}
|
||||
}
|
||||
Babble_checkattrs($hash);
|
||||
Babble_getids($hash,"new");
|
||||
Babble_getdevs($hash,"new");
|
||||
|
||||
my $pllist = Babble_getplaces($hash,"new",undef);
|
||||
@ -1856,7 +2031,7 @@ sub Babble_Html($)
|
||||
"\" style=\"width:100px;\"/></td></tr>\n";
|
||||
#-- loop over all unique devices to get some sorting
|
||||
if( defined($hash->{DATA}{"devsalias"}) ){
|
||||
for my $alidev (keys %{$hash->{DATA}{"devsalias"}}) {
|
||||
for my $alidev (sort keys %{$hash->{DATA}{"devsalias"}}) {
|
||||
#-- number of devices with this unique
|
||||
my $numalias = int(@{$hash->{DATA}{"devsalias"}{$alidev}});
|
||||
for (my $i=0;$i<$numalias ;$i++){
|
||||
@ -1966,6 +2141,7 @@ sub Babble_Html($)
|
||||
<li>This module uses the global attribute <code>language</code> to determine its output data<br/>
|
||||
(default: EN=english). For German output set <code>attr global language DE</code>.</li>
|
||||
<li>This module needs the JSON package.</li>
|
||||
<li>Only when the chatbot functionality of RiveScript is required, the RiveScript module must be installed as well, see https://github.com/aichaos/rivescript-perl</li>
|
||||
</ul>
|
||||
<h4>Usage</h4>
|
||||
To use this module, call the Perl function <code>Babble_DoIt("<name>","<sentence>"[,<parm0>,<parm1>,...])</code>.
|
||||
@ -1979,6 +2155,7 @@ sub Babble_Html($)
|
||||
and strings $PARM[0|1|2...] will be replaced by the
|
||||
corresponding parameters passed to the function <code>Babble_DoIt</code>
|
||||
<ul>
|
||||
<li>If no stored command ist found, the sentence is passed to the local RiveScript interpreter if present</li>
|
||||
<li>To have a FHEM register itself as a Babble Device, it must get an attribute value <code>babbleDevice=<name></code>. The <i>name</i> parameter must either be
|
||||
unique to the Babble system, or it muts be of the form <code><name>_<digits></code></li>
|
||||
<li>Devices on remote FHEM installations are defined in the <code>babbleDevices</code> attribute, see below</li>
|
||||
@ -1995,6 +2172,10 @@ sub Babble_Html($)
|
||||
<code>set <name> save|restore</code>
|
||||
</a>
|
||||
<br />Manually save/restore the babble to/from the external file babbleFILE (save done automatically at each state modification, restore at FHEM start)</li>
|
||||
<li><a name="babble_rivereload">
|
||||
<code>set <name> rivereload</code>
|
||||
</a>
|
||||
<br />Reload data for RiveScript Interpreter</li>
|
||||
<li><a name="babble_test">
|
||||
<code>set <name> test</code>
|
||||
</a>
|
||||
@ -2027,12 +2208,16 @@ sub Babble_Html($)
|
||||
<li><a name="testParm"><code>attr <name> testParm(0|1|2|3) <string&rt;</code></a>
|
||||
<br/>if a command is not really excuted, but only tested, the values of these attributes will be used to substitute the strings $PARM[0|1|2...]
|
||||
in the tested command</li>
|
||||
<li><a name="noChatBot"><code>attr <name> noChatBot 0|1</code></a>
|
||||
<br/>if this attribute is set to 1, a local RiveScript interpreter will be ignored even though it is present in the system</li>
|
||||
<li><a name="remoteFHEM"><code>attr <name> remoteFHEM(0|1|2|3) <IP address:port&rt;</code></a>
|
||||
<br/>IP address and port for a remote FHEM installation</li>
|
||||
<li><a name="remoteFunc"><code>attr <name> remoteFunc(0|1|2|3) <function name&rt;</code></a>
|
||||
<br/>name of a Perl function that is called for addressing a certain remote FHEM device</li>
|
||||
<li><a name="remoteToken"><code>attr <name> remoteToken(0|1|2|3) <csrfToken&rt;</code></a>
|
||||
<br/>csrfToken for addressing a certain remote FHEM device</li>
|
||||
<li><a name="babbleIds"><code>attr <name> babbleIds <id_1> <id_2> ...</code></a>
|
||||
<br />space separated list of identities by which babble may be addressed</li>
|
||||
<li><a name="babblePlaces"><code>attr <name> babblePlaces <place_1> <place_2> ...</code></a>
|
||||
<br />space separated list of special places to be identified in speech</li>
|
||||
<li><a name="babbleNotPlaces"><code>attr <name> babbleNoPlaces <place_1> <place_2> ...</code></a>
|
||||
|
21
fhem/contrib/Babble/begin.rive
Normal file
21
fhem/contrib/Babble/begin.rive
Normal file
@ -0,0 +1,21 @@
|
||||
//########################################################################################
|
||||
// begin.rive
|
||||
// Version 0.1
|
||||
// See 95_Babble.pm for licensing
|
||||
//########################################################################################
|
||||
//# Prof. Dr. Peter A. Henning
|
||||
! version = 2.0
|
||||
|
||||
// Bot variables
|
||||
// Name of house spirit in writing
|
||||
! var name = Jeannie
|
||||
// Name of house spirit in speaking
|
||||
! var name2 = dschini
|
||||
// Name of house master
|
||||
! var master = Peter
|
||||
|
||||
// Substitutions for house spirit name
|
||||
! sub jenny = jeannie
|
||||
! sub tini = jeannie
|
||||
|
||||
|
87
fhem/contrib/Babble/general.rive
Normal file
87
fhem/contrib/Babble/general.rive
Normal file
@ -0,0 +1,87 @@
|
||||
//########################################################################################
|
||||
// general.rive
|
||||
// Version 0.1
|
||||
// See 95_Babble.pm for licensing
|
||||
//########################################################################################
|
||||
//# Prof. Dr. Peter A. Henning
|
||||
|
||||
+ hallo
|
||||
- Hallo, ich bin <bot name2>. Wer bist Du ?
|
||||
|
||||
+ wer bist du
|
||||
- Hallo, ich bin <bot name2>. Wer bist Du ?
|
||||
|
||||
+ hallo *
|
||||
* <star> == <bot name> => Hallo. Wer bist Du ?
|
||||
- Ich heisse nicht <star>, sondern <bot name2>. Wer bist Du ?
|
||||
|
||||
+ ich bin *
|
||||
* <formal> == <bot master> => Gerne zu Diensten, Meister! <set name=<formal>>
|
||||
* <formal> == <bot name> => Sehr schoen, wir haben denselben Namen! <set name=<formal>>
|
||||
* <formal> == <get name> => Das sagtest Du schon. Komm zur Sache, <get name>!
|
||||
* <get name> == undefined => <set name=<formal>>Schoen, Dich kennenzulernen, <get name>!
|
||||
- <set oldname=<get name>><set name=<formal>>
|
||||
^ Ich dachte, Dein Name sei <get oldname>? Bitte noch einmal! <set name=undefined>
|
||||
|
||||
+ was kannst du * * tun
|
||||
- Ich kann <star1> Dich das Haus steuern
|
||||
- Ich kann ganz verschiedene Dinge im Haus schalten und steuern
|
||||
|
||||
+ welche (orte|ortsangaben) kennst du
|
||||
- <call>places</call>
|
||||
|
||||
+ was kannst du (steuern|schalten)
|
||||
- <call>devices</call>
|
||||
|
||||
+ (welche|welches) * kennst du
|
||||
- <call>devices</call>
|
||||
|
||||
+ wie kannst du * (steuern|schalten)
|
||||
- <call>devhelp <star></call>
|
||||
|
||||
+ was ist *
|
||||
- <call>devhelp <star></call>
|
||||
|
||||
|
||||
// object to get known devices
|
||||
> object devices perl
|
||||
my $hash = $main::defs{"Babble"};
|
||||
my $str;
|
||||
if( defined($hash->{DATA}{"devsalias"}) ){
|
||||
my @da = keys %{$hash->{DATA}{"devsalias"}};
|
||||
my $dl = pop @da;
|
||||
$str = "Ich kenne die folgenden Ger\xc3\xa4te: ".join(", ",@da)." und ".$dl;
|
||||
}else{
|
||||
$str = "Ich kann keine Ger\xc3\xa4te finden";
|
||||
}
|
||||
return $str;
|
||||
< object
|
||||
|
||||
// object to get known places
|
||||
> object places perl
|
||||
my $hash = $main::defs{"Babble"};
|
||||
my $str;
|
||||
if( defined($hash->{DATA}{"places"}) ){
|
||||
my @pa = @{$hash->{DATA}{"places"}};
|
||||
my $pl = pop @pa;
|
||||
$str = "Ich kenne die folgenden Orte: ".join(", ",@pa)." und ".$pl;
|
||||
}else{
|
||||
$str = "Ich kann leider keine Orte finden";
|
||||
}
|
||||
return $str;
|
||||
< object
|
||||
|
||||
// object to get help text for a device
|
||||
> object devhelp perl
|
||||
my ($rs, $bdev) = @_;
|
||||
my $lbdev = lc($bdev);
|
||||
my $hash = $main::defs{"Babble"};
|
||||
my $str = $hash->{DATA}{"help"}{$lbdev};
|
||||
if( !defined($str) || $str eq "" ){
|
||||
$str = "Keine Ahnung, das Ger\xc3\xa4t $bdev kenne ich nicht";
|
||||
}
|
||||
return $str;
|
||||
< object
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user