From 450189b1317633404cfa0798e87eadac11f68435 Mon Sep 17 00:00:00 2001 From: ststrobel <> Date: Fri, 21 Nov 2014 16:35:16 +0000 Subject: [PATCH] 98_FReplacer.pm: Neues Modul eingecheckt git-svn-id: https://svn.fhem.de/fhem/trunk@7033 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/98_FReplacer.pm | 393 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 393 insertions(+) create mode 100755 fhem/FHEM/98_FReplacer.pm diff --git a/fhem/FHEM/98_FReplacer.pm b/fhem/FHEM/98_FReplacer.pm new file mode 100755 index 000000000..1dda3823e --- /dev/null +++ b/fhem/FHEM/98_FReplacer.pm @@ -0,0 +1,393 @@ +############################################## +# $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 + +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, + # z.B. um SVG in PNG zu konvertieren + +} + + +##################################### +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"; + } + } + } + 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