# Id ########################################################################## # $Id$ # # copyright ################################################################### # # 76_msgDialog.pm # # Originally initiated by igami # # This file is part of FHEM. # # FHEM is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # FHEM is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with FHEM. If not, see . # packages #################################################################### package FHEM::Communication::msgDialog; ##no critic qw(Package) use strict; use warnings; #use Carp qw(carp); use GPUtils qw(GP_Import); use JSON (); # qw(decode_json encode_json); use Encode; #use HttpUtils; use utf8; use Time::HiRes qw(gettimeofday); sub ::msgDialog_Initialize { goto &Initialize } # variables ################################################################### my $msgDialog_devspec = 'TYPE=(ROOMMATE|GUEST):FILTER=msgContactPush=.+'; BEGIN { GP_Import( qw( addToDevAttrList readingsSingleUpdate readingsBeginUpdate readingsBulkUpdate readingsEndUpdate Log3 defs attr modules L init_done InternalTimer RemoveInternalTimer readingFnAttributes IsDisabled AttrVal InternalVal ReadingsVal devspec2array AnalyzeCommandChain AnalyzeCommand EvalSpecials AnalyzePerlCommand perlSyntaxCheck parseParams ResolveDateWildcards FileRead getAllSets setNotifyDev setDisableNotifyFn deviceEvents trim ) ) }; # initialize ################################################################## sub Initialize { my $hash = shift // return; $hash->{DefFn} = \&Define; $hash->{SetFn} = \&Set; $hash->{GetFn} = \&Get; $hash->{AttrFn} = \&Attr; $hash->{NotifyFn} = \&Notify; $hash->{AttrList} = "allowed:multiple-strict,everyone ". "disable:0,1 ". "disabledForIntervals ". "evalSpecials:textField-long ". "msgCommand configFile ". $readingFnAttributes ; return; } # regular Fn ################################################################## sub Define { my $hash = shift // return; my $def = shift // return; my ($SELF, $TYPE, $DEF) = split m{[\s]+}x, $def, 3; if (!eval{ require JSON; JSON->import(); 1; } ) { return ( "Error loading JSON. Maybe this module is not installed? ". "\nUnder debian (based) system it can be installed using ". "\"apt-get install libjson-perl\"" ) } return $init_done ? firstInit($hash) : InternalTimer(time+1, \&firstInit, $hash ); } sub firstInit { my $hash = shift // return; my $name = $hash->{NAME}; return( "No global configuration device defined: ". "Please define a msgConfig device first" ) if !$modules{msgConfig}{defptr}; my $msgConfig = $modules{msgConfig}{defptr}{NAME}; addToDevAttrList($msgConfig, 'msgDialog_evalSpecials:textField-long', 'msgDialog'); addToDevAttrList($msgConfig, 'msgDialog_msgCommand:textField', 'msgDialog'); if (!IsDisabled($name) ) { setDisableNotifyFn($hash, 0); setNotifyDev($hash,'TYPE=(ROOMMATE|GUEST)'); } my $cfg = AttrVal($name,'configFile',undef); my $content; if ($cfg) { (my $ret, $content) = _readConfigFromFile($hash, $cfg); return $ret if $ret; $hash->{DIALOG} = $content; } else { $content = InternalVal($name, 'DEF', '{}'); delete $hash->{DIALOG}; } delete $hash->{TRIGGER}; my $content2 = msgDialog_evalSpecials($hash, $content); if ( !eval{ $content2 = JSON->new->decode($content2); 1;} ){ #decode_json will cause problems with utf8 Log3($hash, 2, "msgDialog ($name) - DEF or configFile is not a valid JSON: $@"); return("Usage: define msgDialog {JSON}\n\n$@"); } my @TRIGGER; for (keys %{$content2}){ next if ref $content2->{$_} ne 'HASH'; next if defined $content2->{$_}->{setOnly}; # && $content2->{$_}->{setOnly} eq 'true'; push @TRIGGER, $_; } $hash->{TRIGGER} = join q{,}, @TRIGGER; msgDialog_update_msgCommand($hash); msgDialog_reset($hash); msgDialog_updateAllowed(); return; } sub Set { my ($hash,$SELF,$argument,@values) = @_; my $TYPE = $hash->{TYPE}; return qq("set $TYPE" needs at least one argument) if !$argument; my $value = join q{ }, @values; my %sets = ( reset => 'reset:noArg', say => 'say:textField', updateAllowed => 'updateAllowed:noArg', update => 'update:allowed,configFile' ); Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_Set"); return "Unknown argument $argument, choose one of ".join q{ }, values %sets if !defined $sets{$argument}; if ( $argument eq 'reset' ){ return msgDialog_reset($hash); } if( $argument eq 'update'){ return msgDialog_updateAllowed() if $values[0] eq 'allowed'; return firstInit($hash) if $values[0] eq 'configFile'; } if( $argument eq 'updateAllowed'){ return msgDialog_updateAllowed(); } return if IsDisabled($SELF); if ( $argument eq 'say' && $value ){ my $recipients = join q{,}, ($value =~ m/@(\S+)\s+/g); $recipients = AttrVal($SELF, 'allowed', '') if !$recipients; my (undef, $say) = ($value =~ m/(^|\s)([^@].+)/g); return if !$recipients && !$say; msgDialog_progress($hash, $recipients, $say, 1); } return; } sub Get { my ($hash,$SELF,$argument,@values) = @_; my $TYPE = $hash->{TYPE}; return "\"get $TYPE\" needs at least one argument" if !$argument; my $value = join q{ }, @values; my %gets = ( trigger => 'trigger:noArg' ); Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_Get"); return "Unknown argument $argument, choose one of ".join q{ }, values %gets if !exists $gets{$argument}; return if IsDisabled($SELF); if($argument eq 'trigger'){ return join "\n", split q{,}, InternalVal($SELF, 'TRIGGER', undef); #we need the soft variant } return; } sub Attr { my ($cmd, $SELF, $attribute, $value) = @_; my $hash = $defs{$SELF}; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_Attr"); if ($attribute eq 'disable'){ if($cmd eq 'set' and $value == 1){ setDisableNotifyFn($hash, 1); return readingsSingleUpdate($hash, 'state', 'Initialized', 1); #Beta-User: really?!? } readingsSingleUpdate($hash, 'state', 'disabled', 1); return firstInit($hash) if $init_done; return; } if ( $attribute eq 'msgCommand'){ if($cmd eq 'set'){ $attr{$SELF}{$attribute} = $value; } else{ delete $attr{$SELF}{$attribute}; } return msgDialog_update_msgCommand($hash); } if ( $attribute eq 'configFile' ) { if ($cmd ne 'set') { delete $hash->{CONFIGFILE}; delete $hash->{DIALOG}; $value = undef; delete $attr{$SELF}{$attribute}; } $attr{$SELF}{$attribute} = $value; return firstInit($hash); } return; } sub Notify { my $hash = shift // return; my $dev_hash = shift // return; my $SELF = $hash->{NAME}; my $TYPE = $hash->{TYPE}; my $device = $dev_hash->{NAME}; Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_Notify"); return if IsDisabled($SELF); my @events = @{deviceEvents($dev_hash, 1)}; return if !@events || AttrVal($SELF, 'allowed', '') !~ m{\b(?:$device|everyone)(?:\b|\z)}xms; for my $event (@events){ next if $event !~ m{(?:fhemMsgPushReceived|fhemMsgRcvPush):.(.+)}xms; Log3($SELF, 4 , "$TYPE ($SELF) triggered by \"$device $event\""); msgDialog_progress($hash, $device, $1); } return; } # module Fn ################################################################### sub msgDialog_evalSpecials { my $hash = shift // return; my $string = shift // return; my $SELF = $hash->{NAME}; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_evalSpecials"); my $msgConfig; $msgConfig = $modules{msgConfig}{defptr}{NAME} if $modules{msgConfig}{defptr}; $string =~ s/\$SELF/$SELF/g; my $evalSpecials = AttrVal($msgConfig, 'msgDialog_evalSpecials', ''); $evalSpecials .= ' '; $evalSpecials .= AttrVal($SELF, 'evalSpecials', ''); return $string if $evalSpecials eq ' '; (undef, $evalSpecials) = parseParams($evalSpecials, "\\s", " "); return $string if !$evalSpecials; for ( keys %{$evalSpecials} ) { $evalSpecials->{$_} = AnalyzePerlCommand($hash, $evalSpecials->{$_}) if($evalSpecials->{$_} =~ m/^{.*}$/); } my $specials = join q{|}, keys %{$evalSpecials}; $string =~ s{%($specials)%}{$evalSpecials->{$1}}g; return $string; } sub msgDialog_progress { my $hash = shift // return; my $recipients = shift // return; my $message = shift // return; my $force = shift; my $SELF = $hash->{NAME}; my $TYPE = $hash->{TYPE}; $recipients = join q{,}, devspec2array($msgDialog_devspec) if $recipients eq 'everyone'; return if !$recipients; Log3( $SELF, 5 , "$TYPE ($SELF)" . "\n entering msgDialog_progress" . "\n recipients: $recipients" . "\n message: $message" . "\n force: ".($force ? $force : 0) ); my @oldHistory; @oldHistory = split "\\|", ReadingsVal($SELF, "$recipients\_history", "") if !$force; push @oldHistory, split "\\|", $message; my (@history); my $dialog = $hash->{DIALOG} // $hash->{DEF} // q{}; $dialog = msgDialog_evalSpecials($hash, $dialog); $dialog =~ s{\$recipient}{$recipients}g; if ( !eval{ $dialog = JSON->new->decode($dialog); 1;} ){ return Log3($SELF, 2, "$TYPE ($SELF) - Error decoding JSON: $@"); } for (@oldHistory){ $message = $_; if ( defined $dialog->{$message} ){ $dialog = $dialog->{$message}; push @history, $message; } else{ for (keys %{$dialog}){ next if $dialog->{$_} !~ m{HASH} || !defined($dialog->{$_}{match}) || $message !~ m{\A$dialog->{$_}{match}\z} ; $dialog = $dialog->{$_}; push @history, $_; last; } } } return if @history != @oldHistory || !$force && $dialog->{setOnly}; #$dialog = eval{JSON->new->encode($dialog)}; if ( !eval{ $dialog = JSON->new->encode($dialog); 1;} ) { return Log3($SELF, 2, "$TYPE ($SELF) - Error encoding JSON: $@"); } $dialog =~ s{\$message}{$message}g; if ( !eval{ $dialog = JSON->new->decode($dialog); 1;} ) { return Log3($SELF, 2, "$TYPE ($SELF) - Error decoding JSON: $@"); } my $history = ''; for ( keys %{$dialog} ) { if($_ !~ m{(?:setOnly|match|commands|message)}){ $history = join q{|}, @history; last; } } readingsBeginUpdate($hash); readingsBulkUpdate($hash, $_."_history", $history) for ( split q{,}, $recipients ); readingsBulkUpdate($hash, 'state', "$recipients: $message"); readingsEndUpdate($hash, 1); if($dialog->{commands}){ my @commands = $dialog->{commands} =~ m{ARRAY} ? @{$dialog->{commands}} : $dialog->{commands} ; for (@commands){ $_ =~ s{;}{;;}g if $_ =~ m{\A\{.*\}\z}s; my $ret = AnalyzeCommandChain($hash, $_); Log3($SELF, 4, "$TYPE ($SELF) - return from command \"$_\": $ret") if $ret; } } return if !$dialog->{message}; my @message = $dialog->{message} =~ m{ARRAY} ? @{$dialog->{message}} : $dialog->{message} ; for (@message){ if($_ =~ m{\A\{.*\}\z}s){ $_ =~ s{;}{;;}g; $_ = AnalyzePerlCommand($hash, $_); } } $message = join "\n", @message; #we need the soft variant my $msgCommand = InternalVal($SELF, 'MSGCOMMAND', ''); my %specials = ( "%SELF" => $SELF, "%TYPE" => $TYPE, "%recipients" => $recipients, "%message" => $message ); $msgCommand = EvalSpecials($msgCommand, %specials); $msgCommand =~ s{\\[\@]}{@}x; AnalyzeCommandChain($hash, $msgCommand); #$msgCommand =~ s{\\[\@]}{@}x; #$msgCommand =~ s{(\$\w+)}{$1}eegx; #AnalyzeCommand($hash, $msgCommand); return; } sub msgDialog_reset { my $hash = shift // return; my $SELF = $hash->{NAME}; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_reset"); delete $hash->{READINGS}; readingsSingleUpdate($hash, 'state', 'Initialized', 1) if !IsDisabled($SELF); return; } sub msgDialog_updateAllowed { Log3('global',5, 'msgDialog - entering msgDialog_updateAllowed'); my $allowed = join q{,}, devspec2array($msgDialog_devspec); $modules{msgDialog}{AttrList} =~ s{allowed:multiple-strict,\S*}{allowed:multiple-strict,everyone,$allowed}; return; } sub msgDialog_update_msgCommand { my $hash = shift // return; my $SELF = $hash->{NAME}; my $TYPE = $hash->{TYPE}; my $msgConfig = $modules{msgConfig}{defptr}{NAME}; Log3($SELF, 5, "$TYPE ($SELF) - entering msgDialog_update_msgCommand"); $hash->{MSGCOMMAND} = AttrVal($SELF, 'msgCommand', AttrVal($msgConfig, "$TYPE\_msgCommand", 'msg push \@$recipients $message' ) ) ; return; } sub _getDataFile { my $hash = shift // return; my $filename = shift; my $name = $hash->{NAME}; $filename = $filename // AttrVal($name,'configFile',undef); my @t = localtime gettimeofday(); $filename = ResolveDateWildcards($filename, @t); $hash->{CONFIGFILE} = $filename; # for configDB migration return $filename; } sub _readConfigFromFile { my $hash = shift // return 'no device reference provided!', undef; my $cfg = shift // return 'no filename provided!', undef; my $name = $hash->{NAME}; my $filename = _getDataFile($hash, $cfg); Log3($name, 5, "trying to read config from $filename"); my ($ret, @content) = FileRead($filename); if ($ret) { Log3($name, 1, "$name failed to read configFile $filename!") ; return $ret, undef; } my @cleaned = grep { $_ !~ m{\A\s*[#]}x } @content; return 0, join q{ }, @cleaned; } 1; __END__ # commandref ################################################################## =pod =encoding utf8 =item helper =item summary dialogs for instant messaging =item summary_DE Dialoge für Sofortnachrichten =begin html

msgDialog

=end html =begin html_DE

msgDialog

=end html_DE =cut