############################################## # $Id: 98_FReplacer.pm # # Basiert auf der Idee Fhem Daten auf einem Kindle anzuzeigen # wie im Forum beschrieben # ############################################################################## # Changelog: # # 2014-07-12 initial version # 2014-10-02 fixed some minor issues and added documentation # 2014-10-19 fixed a typo and some minor issues # 2014-11-04 renamed some attributes and added PostCommand to make the module more flexible # 2014-11-08 added the attributes Reading.*, MaxAge.*, MinValue.*, MaxValue.* and Format.* # 2014-11-15 fixed bugs related to RepReading and InternalTimer # 2014-12-05 definierte Attribute werden der userattr list der Instanz hinzugefügt package main; use strict; use warnings; use Time::HiRes qw( time ); use POSIX qw(strftime); use Encode qw(decode encode); sub FReplacer_Initialize($); sub FReplacer_Define($$); sub FReplacer_Undef($$); sub FReplacer_Update($); sub FReplacer_Attr(@); require "$attr{global}{modpath}/FHEM/99_Utils.pm"; ##################################### sub FReplacer_Initialize($) { my ($hash) = @_; $hash->{DefFn} = "FReplacer_Define"; $hash->{UndefFn} = "FReplacer_Undef"; $hash->{AttrFn} = "FReplacer_Attr"; $hash->{SetFn} = "FReplacer_Set"; $hash->{AttrList}= "Rep[0-9]+Regex " . # Match für Ersetzungen "Rep[0-9]+Reading " . # Reading for Replacement "Rep[0-9]+MaxAge " . # optional Max age of Reading "Rep[0-9]+MinValue " . # optional Min Value of Reading "Rep[0-9]+MaxValue " . # optional Max Value of Reading "Rep[0-9]+Format " . # optional Format string for Replacement "Rep[0-9]+Expr " . # optional Expression to be evaluated before using the replacement "ReplacementEncode " . # Ergebnis einer Ersetzung z.B. in UTF-8 Encoden "PostCommand " . # Systembefehl, der nach der Ersetzung ausgeführt wird $readingFnAttributes; } ##################################### sub FReplacer_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t]+", $def); my ($name, $FReplacer, $template, $output, $interval) = @a; return "wrong syntax: define FReplacer [Template] [Output] [interval]" if(@a < 4); $hash->{TEMPLATE} = $template; $hash->{OUTPUT} = $output; if (!defined($interval)) { $hash->{INTERVAL} = 60; } else { $hash->{INTERVAL} = $interval; } RemoveInternalTimer ($hash); InternalTimer(gettimeofday()+1, "FReplacer_Update", $hash, 0); return undef; } ##################################### sub FReplacer_Undef($$) { my ($hash, $arg) = @_; #my $name = $hash->{NAME}; RemoveInternalTimer ($hash); return undef; } # # Attr command ############################################################## sub FReplacer_Attr(@) { my ($cmd,$name,$aName,$aVal) = @_; # $cmd can be "del" or "set" # $name is device name # aName and aVal are Attribute name and value # Attributes are Regexp.*, Expr.* # Regex.* and Expr.* need validation if ($cmd eq "set") { if ($aName =~ "Regex") { eval { qr/$aVal/ }; if ($@) { Log3 $name, 3, "$name: Invalid regex in attr $name $aName $aVal: $@"; return "Invalid Regex $aVal in $aName"; } } elsif ($aName =~ "Expr") { my $replacement = ""; eval $aVal; if ($@) { Log3 $name, 3, "$name: Invalid Expression in attr $name $aName $aVal: $@"; return "Invalid Expression $aVal in $aName"; } } elsif ($aName =~ "MaxAge") { if ($aVal !~ '([0-9]+):(.+)') { Log3 $name, 3, "$name: wrong format in attr $name $aName $aVal"; return "Invalid Format $aVal in $aName"; } } elsif ($aName =~ "MinValue") { if ($aVal !~ '(^-?\d+\.?\d*):(.+)') { Log3 $name, 3, "$name: wrong format in attr $name $aName $aVal"; return "Invalid Format $aVal in $aName"; } } elsif ($aName =~ "MaxValue") { if ($aVal !~ '(^-?\d+\.?\d*):(.+)') { Log3 $name, 3, "$name: wrong format in attr $name $aName $aVal"; return "Invalid Format $aVal in $aName"; } } elsif ($aName =~ "Format") { my $useless = eval { sprintf ($aVal, 1) }; if ($@) { Log3 $name, 3, "$name: Invalid Format in attr $name $aName $aVal: $@"; return "Invalid Format $aVal"; } } addToDevAttrList($name, $aName) } return undef; } # SET command ######################################################################### sub FReplacer_Set($@) { my ( $hash, @a ) = @_; return "\"set $a[0]\" needs at least an argument" if ( @a < 2 ); # @a is an array with DeviceName, SetName, Rest of Set Line my ($name, $setName, $setVal) = @a; if($setName eq "ReplaceNow") { Log3 $name, 5, "$name: Set ReplaceNow is calling FReplacer_Update"; RemoveInternalTimer ($hash); FReplacer_Update($hash); } else { return "Unknown argument $setName, choose one of ReplaceNow"; } } ##################################### sub FReplacer_Update($) { my ($hash) = @_; my $name = $hash->{NAME}; InternalTimer(gettimeofday()+$hash->{INTERVAL}, "FReplacer_Update", $hash, 0); Log3 $name, 5, "$name: Update: Internal timer set for hash $hash to call update again in $hash->{INTERVAL} seconds"; my ($tmpl, $out); if (!open($tmpl, "<", $hash->{TEMPLATE})) { Log3 $name, 3, "$name: Cannot open template file $hash->{TEMPLATE}"; return; }; if (!open($out, ">", $hash->{OUTPUT})) { Log3 $name, 3, "$name: Cannot create output file $hash->{OUTPUT}"; return; }; my $content = ""; while (<$tmpl>) { $content .= $_; } my $time = strftime("%d.%m.%Y %T", localtime); readingsSingleUpdate($hash, "LastUpdate", $time, 1 ); foreach my $key (keys %{$attr{$name}}) { if ($key =~ /Rep([0-9]+)Regex/) { my $index = $1; my $regex = $attr{$name}{"Rep${index}Regex"}; my $replacement = ""; my $skip = 0; if ($attr{$name}{"Rep${index}Reading"}) { if ($attr{$name}{"Rep${index}Reading"} !~ '([^\:]+):([^\:]+):?(.*)') { Log3 $name, 3, "$name: wrong format in attr Rep${index}Reading"; next; } my $device = $1; my $rname = $2; my $default = ($3 ? $3 : 0); my $timestamp = ReadingsTimestamp ($device, $rname, 0); $replacement = ReadingsVal($device, $rname, $default); Log3 $name, 5, "$name: got reading $rname of device $device with default $default as $replacement with timestamp $timestamp"; if ($attr{$name}{"Rep${index}MaxAge"}) { if ($attr{$name}{"Rep${index}MaxAge"} !~ '([0-9]+):(.+)') { Log3 $name, 3, "$name: wrong format in attr Rep${index}MaxAge"; next; } my $max = $1; my $rep = $2; Log3 $name, 5, "$name: check max age $max"; if (gettimeofday() - time_str2num($timestamp) > $max) { Log3 $name, 5, "$name: reading too old - using $rep instead and skipping optional Expr and Format attributes"; $replacement = $rep; $skip = 1; } } if ($attr{$name}{"Rep${index}MinValue"} && !$skip) { if ($attr{$name}{"Rep${index}MinValue"} !~ '(^-?\d+\.?\d*):(.+)') { Log3 $name, 3, "$name: wrong format in attr Rep${index}MinValue"; next; } my $lim = $1; my $rep = $2; Log3 $name, 5, "$name: check min value $lim"; if ($replacement < $lim) { Log3 $name, 5, "$name: reading too small - using $rep instead and skipping optional Expr and Format attributes"; $replacement = $rep; $skip = 1; } } if ($attr{$name}{"Rep${index}MaxValue"} && !$skip) { if ($attr{$name}{"Rep${index}MaxValue"} !~ '(^-?\d+\.?\d*):(.+)') { Log3 $name, 3, "$name: wrong format in attr Rep${index}MaxValue"; next; } my $lim = $1; my $rep = $2; Log3 $name, 5, "$name: check max value $lim"; if ($replacement > $lim) { Log3 $name, 5, "$name: reading too big - using $rep instead and skipping optional Expr and Format attributes"; $replacement = $rep; $skip = 1; } } } if ($attr{$name}{"Rep${index}Expr"} && !$skip) { Log3 $name, 5, "$name: Evaluating Expr" . $attr{$name}{"Rep${index}Expr"} . "\$replacement = $replacement"; $replacement = eval($attr{$name}{"Rep${index}Expr"}); Log3 $name, 5, "$name: result is $replacement"; if ($@) { Log3 $name, 3, "$name: error evaluating attribute Rep${index}Expr: $@"; next; } } if ($attr{$name}{"Rep${index}Format"} && !$skip) { Log3 $name, 5, "$name: doing sprintf with format" . $attr{$name}{"Rep${index}Format"} . "value is $replacement"; $replacement = sprintf($attr{$name}{"Rep${index}Format"}, $replacement); Log3 $name, 5, "$name: result is $replacement"; } Log3 $name, 5, "$name: Replacing $regex with $replacement"; $replacement = encode(AttrVal($name, "ReplacementEncode", undef), $replacement) if (AttrVal($name, "ReplacementEncode", undef)); Log3 $name, 5, "$name: Replacement encoded as $replacement"; $content =~ s/$regex/$replacement/g; } } print $out $content; if (AttrVal($name, "PostCommand", undef)) { my $convCmd = (AttrVal($name, "PostCommand", undef)); Log3 $name, 5, "$name: Start conversion as $convCmd"; system ($convCmd); Log3 $name, 5, "$name: Conversion started"; } } 1; =pod =begin html

FReplacer

=end html =cut